perm filename CLEAN.FAI[MUD,SYS] blob
sn#553556 filedate 1981-01-03 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00075 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00010 00002 ASSEMBLY SWITCHES, OPDEFS, AC'S
C00016 00003 BIT DEFS, IO CHANNELS
C00024 00004 UUOCON DEVBIT LABEL MFDBUF LUFD SRCH ODEV IDEV LSTDEV CMDDEV DTAIN1 DTAIN2 MFDDEV UDPDEV UFDDEV UPRDEV UPRBLK SPLNAM SPLDEV SPWCMA SPLBLK RQNAM RQJOB FSIZE RQTIME FNAME FEXT FDAT FPPN ANAME AEXT APPN CBITS SPLLEN MAIBUF PASDEV PASNAM CMDLST PASWRD RDOFF OFFSET REALLN WRTOFF SETOFF PAGE DDDDON PAGBUF DPYWRD LPAGBF DDDCMD DDDPOS IIIPOS DMPOS PHONY FCNMAX FCNAM FCEXT FCPPN FCLEN FCPERM FCTMP1 FCTMP2 FCDOIT FCDNAM FCDEXT FCDPPN FCDNUM FCERRM XGPSER FCRESP FONTER ERCODE FCSELB FCSELT FCBITS MARSET ILINES DLINES FULFLG TIMFLG PROFLG UPRFLG UIGFLG BTHRES BIGNLY OFFNLY DMPFLG REFFLG WRIFLG OFFFLG RDRETR RETRBF FREEBL FREBIE NBUFS BKDSIZ PGWAIT
C00031 00005 ZERO DATA LOCS
C00034 00006 ↓CLRBFI CLRBF1 CLRBF2 CLRBF3 CHRMS2 ILL1 WRDM2 RECOV CKDIR CKNAME NORMFL UFDFIL PERIOD SYSCHK DEVBT1 FCREST FCCLR FCCLR1 FCERRP XGPTAB ILSCOD XCODEP XCODEQ FCERR1 FCRTAB ILFCOD FNTER1 FNTTAB ILFCCD ILFCCM FCLKER
C00045 00007 .UUOCN UUOCN1 DISTAB SEV1 SIXO1 SIXS1 PPNO1 PPNS1
C00048 00008 START SCNAGN SCAN2 SCAN3
C00052 00009 SCNTAB SCNLST
C00054 00010 LFCHK1 LFCHK SCNOUT REMOD SYSMOD
C00057 00011 BUNCH
C00061 00012 GETLST LSTTRM LSTAGN GETDST DTERM1 DETERM
C00065 00013 DFTTRM SETSPL ISXGP LPTAGN DESTRM SPOCHK
C00071 00014 MAKTRM MAKTR4 ISPOK
C00075 00015 PPNOK MAKTR1 NOIMG1 NOIMG2 CLIMAG NOTRAN GOTMEM FCLOP fclop2 FCLOP1 GOTMM1 STKPG MAKEND STKLOS
C00080 00016 DOIT NOALDL INUCK NOUENT ONEDIG STUPID SMART NOSPL
C00085 00017 TTYSET CHK100 NOCONF NXLIST NODIRD
C00089 00018 MODOK XGPSKP XGPDON STKOVR CHKK QUIT NOSPLL NOSPLS DIE NOSPL1 NOSPL2 WOKE SPSTRT
C00095 00019 DATES KPRIN KPRIN1 DELPRN ENDK
C00097 00020 SOURCE TERM STORAGE DSCR
C00099 00021 TERM TERM1 DEVCHK ISDEV FILSCN ISFILN $MAIL2
C00103 00022 BHMHAK SPCSET SPCFIL SPCFL0 SPCFL1 HAKTAB HAKLEN HAKDSP $NEWS $DIGEST $PLAN $BBD $GRIPE $GOLD $MAIME $NAP $MAIL $MAIL0 $MAIM1 $MAI01 $MAIL1 HAK2.2 $DIG2 $FORW2 $FORW $CSD $DAY $NOTICE $MAINT $TXT $OPTION $RPG $RPG1
C00111 00023 EXTSCN GBRACK PPNSCN GETPN TRYPN NOPPN NOPPN1
C00114 00024 INDIR
C00116 00025 STKMAX CMDOPN CMDOP1 CMDOP2 CMDOP3 CMDOP4
C00119 00026 SWITCH SW2 MASKMAK MASKIT AMBIG
C00122 00027 SWTTAB MEND
C00125 00028 EVEN, ODD, BLOCK, BINARY, LENGTH=, ASCII, SEARCH, SRCSWT, FRCASC
C00128 00029 FOOFST
C00130 00030 ISPCX SETASC FONT0S NFCEXT FONTDN FONTDM
C00135 00031 WAIT ALL FOO REFERENCE NOSPACES WRITER OFFSET TIME NOFF UFDPRO PAUSE UIGNORE ACCESS OONLY BONLY
C00138 00032 PTURNON TURNON SWEND SWTLST
C00143 00033 PGLIST PGINC PGLOOP PGLP1
C00146 00034 MESMAK GOTSND SNDMRG
C00150 00035 HELPER
C00152 00036 UDPASS UENLOS NOTRGT PMATCH PASS2 PASJ1 PASJ GETPAS
C00156 00037 CHKPAS DCHK
C00158 00038 HPRINT DSKDHK HPRIN2 <A HDZ ISHEAD ISHD1 HDIS MTDTHD UDPHD DSKHDL DSKFIN DSKHDS PDVTIM DATIME
C00164 00039 EXSTK OWAIT NXGPST EX2A EX2 XGPFN1 XGPFN2 XGPFN3 XGPFN4 FCSEL XFCEXT XFCNUM EX2B EX2C IWAIT
C00173 00040 EX4 NOSRCH GOTPPN GEN1 GEN5 GEN2 DIRSRC
C00176 00041 NODMPB NODMPC FILFIX NODMPD NODSKI FILFX1 NOK
C00181 00042 EOF TRANS2 NOPLUS NOKILL
C00184 00043 HPDIS HMDTA HSHORT HFULL HFULL1 HFULL2 HFULL3 HFULL4 HFULL5 HFUL5A HFUL5B HFULL6 HFULL7 CRLF PPMAYB PPONLY COUNTK FILL
C00193 00044 PDT KOUT0 KOUT PWORDS LEAD40 LEAD41 LEAD4 LEAD42
C00195 00045 DATOU2 DATOUT TIMOU2 TIMOUT PPRO PPRO2 PPRO1
C00197 00046 KILFIL NOCHK NKLUDP MESS22 ERRTAB UNERR MAXERR PPTER0 PPTERM PTERM PTERM2 PTERM1 PTERM3
C00202 00047 GETMFD NOMFD GETPPN NXTWRD JMPIN1 LOADPP PNISTR PISTR
C00206 00048 GETUFD GETUF1 NOUFD GETN1 GETNXT USKP5 NMISTR EXISTR NOUDEV ADUFD INUFD
C00212 00049 DTAUFD GETN2
C00214 00050 DTAUFD
C00215 00051 MTANXT MTAUF1 MTAUFD
C00217 00052 TRANS1 TRANS4 TRAN6 TRAN5 NOOFFS INWRD NOGAP ASCGAP ASCGA1 ASCGA4 ASCGA2 ASCGA3 ASCCHR USETCK
C00223 00053 ENTERO REENTR
C00227 00054 ENTER1 MAKEIT ENTER2
C00230 00055 ENTERG ENTER3 ENTERF RENAM1 NODPAS GOREN REALMS COUNTD
C00235 00056 STOPGA OPT0 OPT1 OPT2
C00237 00057 STPCHK STP1 STP3 STP2 STP4 CRSTP FINWRD ENDBUF
C00241 00058 DMPMOD LINE1 LINE2 LINEON REDMP WRCHK WRCHK1 WRCHK2 INDMP NXTDMP WRDNUM NXTNUM NOSLOP
C00245 00059 TITLPG TITLP1 TIT10 NODIRT GOPART CLINE MLINE NODIRX SPCRLF
C00250 00060 TLINE TLINE1 TLINE2 TLINE3 DECODE DECOD1
C00252 00061 CHRTBL
C00257 00062 SIXST1 SIXOU1 SIXCHR SEVST1 GETBYT PPNST1 PPNOU1 SIXJST OCTOUT POKE POK1 R10TTY RADX10 R10OUT
C00262 00063 PUTCHL PUTCHD PUTCON PUTCN2 FF%LF %LFA %LFB %LFC %FF PGCHK PGCHK1 PGCHK2 PGWAT0 PGWAT PGWAT1 PGWAT2 HDCHK0 HDCHK NOTFUL %HDCHK NODISP %CHR %HDR %HDRNOW %CH12 %CH11 %CH13 %CH14 %CH15 %CH21 %CH177
C00274 00064 PCNTAB DSPTCH QTBL TOPTBL XWD <"
C00277 00065 PUTCHF PUTCHR NXSPC2 NXSPC1 NXSPAC PUTCH1 SNDCHR OUTHIM NXGPER DOAGAIN
C00282 00066 DPYPG DPYDEC DPYDC1
C00284 00067 LPTENT LPTNT1
C00286 00068 LPTHDF LPTHDR LPTPRT LPTPR1 LPTPR2
C00288 00069 GETWRS GETWRD SKPSPC GETCHR GETCH1 SKPCHK GETCH2 GETCH3 GETQ GETWRB GETWRC
C00291 00070 SOCTIN SDECIN SGET OCTIN DECIN SPCNUM GETNUM NUMPUT
C00293 00071 BRKCHK STRCHK STRCK1 ILSTAR CHRFIX
C00295 00072 CMDCHR CMDLF CMDCHB CMDCHC CMDCHA CMDIN CMDCH1 CMDCH2 TTYINP TTYIN
C00300 00073 RCVCHR INHIM INAGAIN EOFCHK
C00304 00074 SPLMAK NOAL NAMTRY SPLLOS NAMOK SPOOK NOSPEX ALIPNT
C00308 00075 PPOPJ1
C00311 ENDMK
C⊗;
;ASSEMBLY SWITCHES, OPDEFS, AC'S
;This is the program to support the system copy command.
;COMPILER SWITCHES!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
↓XGPSW←←1 ;ENABLE XGP KLUDGES
↓SENDSW←←0 ;SEND NOW DONE BY MAIL PROG
↓HELPSW←←0 ;HELP NOW DONE BY HELP PROG
↓PASSSW←←0 ;DISABLE PASSWORDS
↓DISPSW←←1 ;ENABLE DISPLAYING OF PAGE NUMBER
↓PDELSW←←1 ;ENABLE DELETE USING PPN
↓DPROSW←←1 ;ENABLE DELETE PROTECTION
↓STANSW←←1 ;KNOW ABOUT DATE DUMPED, DATE REFERENCED, WRITER, DISK OFFSET
↓RETSW←←1 ;MAKE USE OF BAD RETRIEVAL RETURN FROM LOOKUP, ENTER, ETC.
↓PPNSW←←1 ;1 FOR SIXBIT PPN 0 FOR OCTAL PPN
↓ANDYSW←←0 ;Flushed at last--I hated all those question marks--ME
;FOR TTY'S THAT DON'T HAVE FULL CHARACTER SETS.
;GOD BLESS YOU ANDY MOORER.
↓SPLSW←←1 ;ENABLE SPOOLING OF COPY OUTPUT
↓DEVWAIT←←1 ;ENABLE DEVICE WAIT CAPABILITY
↓FOOSW←←-1 ;ENABLE SPECIAL TYPE DIRECTORY KLUDGE
↓FILHAK←←1 ;ENABLE RPH FILENAME HACK
↓DECSW←←0 ;LOSING DEC
IFE DECSW,<OPDEF DEFPPN[CALLI 400071]>
IFN DECSW,<OPDEF DEFPPN[CALLI 24] ;GETPPN UUO>
OPDEF TTYUUO[51B8]
OPDEF CORE[CALLI 11]
IFNDEF TWO,<TWO←←0 ;DISABLE SHARABLE COPY>
↓TWO←←TWO
IFN TWO,<TWOSEG 400000> ;SETUP FOR RELOC
IFN DECSW,<UDPSW←←0>
IFNDEF UDPSW<UDPSW←←0>
;THIS IS THE USER DISK PACK SWITCH. -1 TURNS IT ON.
;USER DISK PACKS REQUIRE ANOTHER ROUTINE!!!!!!!!!!!!!!!!!!!!!!
OLD←←1 ;1 FOR OLD DECTAPE SERVICE 0 FOR NEW
IFE TWO,<
IFE UDPSW,<TITLE COPY>
IFN UDPSW,<TITLE UCOPY>
>;TWO
IFN TWO,<
IFE UDPSW,<TITLE TCOPY>
IFN UDPSW,<TITLE TUCOPY>
>;TWO
;UUO HANDLER
LOC 40
UUO: 0
JSR UUOCON
RELOC
OPDEF SIXOUT[1B8] ;SIXBIT OUTPUT UUO
OPDEF SIXSTR[2B8] ;SIXBIT OUTPUT UUO TO LSTDEV
OPDEF SEVSTR[3B8] ;ASCII OUTPUT UUO TO LSTDEV
OPDEF PPNOUT[4B8] ;PRJ,PRG OUTPUT UUO
OPDEF PPNSTR[5B8] ; " " " TO LSTDEV
IFN UDPSW,<OPDEF UOUT[6B8] ;USER DISK PACK UUO'S.
OPDEF UIN[7B8]
OPDEF ULOOK[10B8]
OPDEF UENTER[11B8]
OPDEF URENAM[12B8]
OPDEF UOPEN[13B8]
OPDEF UCLOSE[14B8]
OPDEF UDPMES[15B8]
>;UDPSW
IFE DECSW,<OPDEF CHNSTS[716B8] >;GET CHANNEL STATUS C(JOBJDA+CHANNEL #).
IFN DECSW,<OPDEF CHNSTS[SETZM]>
DEFINE TYI<PUSHJ P,TTYIN> ;INSTRUCTION PUT IN CMDGET FOR TTY INPUT
IFE RETSW,<LOC 124
JRST REE ;BAD RETRIEVAL RE-ENTRY POINT (FOR NON-STANFORD).
RELOC >;RETSW
PDL←←100
IFN STANSW,<DQINFB←←15 ;LOC OF WRITER IN RETRIEVAL. ALSO LOGIN DATE IN UFD.>
BLKLEN←←4400 ;DATA WORDS IN ONE DISK BLOCK!
IFN DECSW,<BLKLEN←←200>
LINLEN←←=120 ;LENGTH OF LINE ON LPT!
PGLEN←←=54 ;LENGTH OF PAGE ON LPT!
ALTMOD←←175
IFN DECSW,<LINLEN←←=132
PGLEN←←=60
ALTMOD←←33
>;DECSW
;accumulator assignments.
PRO←1 ;protection register.
BRK←2 ;general pusrpose word register.
WRD←3 ;break character found here.
DEVCHR←4 ;input device characteristics.
TSWTCH←5 ;switch register.
OUTCHR←6 ;output device characteristics.
↓T←7 ;temporary registers.
↓T2←10 ; "
↓T3←11 ; "
↓T4←12 ; "
↓T5←13 ; "
↓ALT←14 ; "
↓DISP←15 ; "
STK←16 ;term stack pointer.
↓P←17 ;pushj pointer.
EXTERNAL JOBFF,JOBOPC,JOBSA,JOBREL
IFN PPNSW,<DEFINE MFDPPN<' 1 1'>>
IFE PPNSW,<DEFINE MFDPPN<1,,1>>
IFNDEF DDTSWT,<DDTSWT←←0>
IFN DDTSWT,<
EXTERNAL $M,DDT
TABLE0: BLOCK =36 ;BIT TABLE FOR TSWTCH BITS
TABLE1: BLOCK =36 ;BIT TABLE FOR PRO BITS
TABLE2: BLOCK =36 ;DEVICE BITS
TBL1: XWD TBL2,TABLE1
TBL2: TABLE2
BIT: MOVE [XWD TBL1,TABLE0]
MOVEM $M+3
JRST DDT
>;DDTSWT
DEFINE LBIT _ (NAME,BIT,TBL),<
NAME←←1B_BIT⊗-=18
IFN DDTSWT,<
RELOC TABLE_TBL+=BIT
RADIX50 0,NAME
RELOC
>;DDTSWT
>;LBIT
DEFINE RBIT _ (NAME,BIT,TBL),<
NAME←←1B_BIT⊗-=18
IFN DDTSWT,<
RELOC TABLE_TBL+=BIT+=18
RADIX50 0,NAME
RELOC
>;DDTSWT
>;RBIT
;BIT DEFS, IO CHANNELS
WRTPRV←←20000 ;USER MAY OVERRIDE WRITE PROTECTION WITH THIS PRIVILAGE
;SO WE LET HIM USE PPN IN DELETE
;THIS BIT IN JBTPRV
REAPRV←←40000 ;USER MAY OVERRIDE READ PROTECTION
PROPRV←←100000 ;USER MAY OVERRIDE PROTECTION PROTECTION
SYSDEV←←100 ;BIT IN RIGHT HALF OF CHNSTS TELLS US OF DEV SYS:
PTYBIT←←4000 ;THIS LINE IS A PTY, AND GETS ALL CHARS UNCHANGED
;special status bits found in left half of devchr and outchr.
LBIT(DSKDEV,1,2) ;disk
IFN UDPSW,<LBIT(UDEV,2,2) ;USER DISK PACK>
IFE UDPSW,<UDEV←←0 ;NO BITS IF NO UDP>
LBIT(LPTDEV,3,2) ;line printer.
LBIT(SAVBIT,6,2) ;PLEASE POPJ ON EOF.
IFN XGPSW,<LBIT(XGPDEV,8,2) ;DEVICE XGP>
IFE XGPSW,<XGPDEV←←0>
LBIT(PTPDEV,9,2) ;paper tape punch
LBIT(PTRDEV,10,2) ;paper tape reader
LBIT(DTADEV,11,2) ;dectape
LBIT(NULHAK,12,2) ;hack for NUL (idiotic LEGDEV crap!!)
LBIT(MTADEV,13,2) ;magtape
LBIT(TTYDEV,14,2) ;teletype
LEGDEV←←NULHAK!DSKDEV!DTADEV!LPTDEV!TTYDEV!MTADEV!PTPDEV!PTRDEV!UDEV!XGPDEV ;legal device.
LBIT(DIRDEV,15,2) ;device has directory.
LBIT(AVAIL,12,2) ;DEVICE IS AVAILABLE TO PROG
SEVOUT←←TTYDEV ;ascii output only
SEVIN←←TTYDEV ;ascii input only
BLKDEV←←DSKDEV!DTADEV!MTADEV!PTRDEV!PTPDEV!LPTDEV!UDEV ;blocked data device.
;These are the tswitch bits(right half).
RBIT(O,0,0) ;/optimize switch.
RBIT(N,1,0) ;/Nonumbers
RBIT(DU,2,0) ;/dumpED
RBIT(SAV,3,0) ;/SAVE
RBIT(L,4,0) ;/list
RBIT(Q,5,0) ;/quiet
RBIT(BLK,6,0) ;/blocked
RBIT(A,7,0) ;/ascii
RBIT(EVEN,8,0) ;even parity for magtape.
RBIT(D556,9,0) ;556 bpi.
RBIT(D200,10,0) ;200 bpi.
D800←←D556!D200 ;800 bpi.
RBIT(S,11,0) ;/search
RBIT(RE,12,0) ;/rename
RBIT(F,13,0) ;/fast
RBIT(FRT,14,0) ;/CONVERT
RBIT(K,15,0) ;/kill
RBIT(TT,16,0) ;/TITLE
RBIT(IMAGE,17,0) ;image mode.
;these are the bits which can be different for input and output
;they are not sticky over left arrow.
DSTNLY←←EVEN!D800!SAV ;ALL MAGTAPE SWITCHES
;(left half). in comment, S means scan X means execution
LBIT(PLSMOD,0,0) ;SX CONCATINATING FILES.
LBIT(HDR,1,0) ;X TIME FOR A HEADER
NOFIL←←HDR ;S NO FILENAME.EXT SEEN IN TERM!
LBIT(DIRSWT,2,0) ;SX DIRECTORY called.
LBIT(LSTSWT,3,0) ;SX LISTING switch.
LBIT(RUNMOD,4,0) ;SX Run by user.
LBIT(DELSWT,5,0) ;SX DELETE COMMAND
LBIT(STRSWT,6,0) ;S SINGLE STAR WAS SCANNED NOT INSIDE ↓'S
DEL177←←STRSWT ;X DANGLING DELETE
LBIT(FIRST,7,0) ;X FIRST TRANS IF ZERO
LBIT(NULFLG,8,0) ;XS NULL TERM SCANNED
LBIT(NOANS,9,0) ;X NO RESPONSE NECESSARY FOR RECMES.
STICKY←←NOANS ;S THIS SWITCH IS STICKY (USED IN SWITCH).
LBIT(TTYSWT,10,0) ;SX listing w/ttyuuo's
IFN SENDSW,<LBIT(SNDSWT,11,0) ;SX SEND called>
;BIT 12 UNUSED
LBIT(LF,13,0) ;X LINE FEED SEEN
IFN HELPSW,<LBIT(HLPSWT,14,0) ;SX HELP THE LOSER>
LBIT(K2,15,0) ;X WE HAVE SEEN AT LEAST 1 FILE SINCE LAST "TOTAL="
LBIT(K3,16,0) ;X WE HAVE DONE AT LEAST 1 "TOTAL="
LBIT(K4,17,0) ;X WE HAVE DONE AT LEAST 2 "TOTAL="
;switch bits in pro (bits 9-17).
;0-8 ;are protection code
LBIT(PP,9,1) ;/PROTECTION
LBIT(H,10,1) ;/HEADER
LBIT(TOT,11,1) ;/GTOTAL
LBIT(IGNO,12,1) ;/IGNO ignore output errors
LBIT(IGNI,13,1) ;/IGNI ignore input errors
LBIT(BIN,14,1) ;/BINARY WORD BY WORD TRANSFER.
LBIT(ASK,15,1) ;/ASK BEFORE EACH TRANSFER.
;LBIT(FULL,16,1) ;/FULL DIRECTORY TYPEOUT (now uses FULFLG)
IFN STANSW,<
LBIT(ALL,17,1) ;/ALL OF THIS FILE
>;STANSW
;bits in right half of pro
RBIT(NAMSTR,0,1) ;FILNAME SPECIFIED BY *
RBIT(EXTSTR,1,1) ;EXT SPECIFIED BY *
RBIT(PSTR,2,1) ;P SPECIFIED BY *
RBIT(PNSTR,3,1) ;PN SPECIFIED BY *
IFN SPLSW,<
RBIT(SPLSWT,4,1) ;/SPOOL
RBIT(SPDSWT,5,1) ;/DSPOOL
>;SPLSW
IFN XGPSW,<
RBIT(ISPACE,6,1) ;/EXTRA IS SCAN LINES NOT TEXT LINES
>;XGPSW
IFN DEVWAIT,<
RBIT(DWAIT,7,1) ;/WAIT for device available
>;DEVWAIT
IFN FOOSW,<
RBIT(FOOSWT,8,1) ;/FOO
>;FOOSW
RBIT(XSPACE,9,1) ;/NOSPACES
RBIT(NOF,10,1) ;/NOFF
;these bits in pro can be different in input and output terms
;and are not sticky over left arrow
DSTPRO←←IFN DEVWAIT,<DWAIT!>IFN SPLSW,<SPLSWT!SPDSWT!>NAMSTR!EXTSTR!PSTR!PNSTR
;bits in DISP and DFTLIN
;0-17 ;avariable length magtape buffers (length) (SEPERATE FOR I/O)
;30-35 ;/EXTRA=
;SPECIAL IOS BITS
IFN DEVWAIT,<
DWAITF←←1000 ;WAIT AUTOMATICALLY FOR DEVICE IF NOT AVAILABLE
>;DEVWAIT
;channel assignments.
FI←←0 ;input
FO←←1 ;output
MFD←←3 ;MFD
UFD←←2 ;UFD
LST←←4 ;list device
SYSCHN←←5 ;for checking sysdev
IFN PASSSW,<PCHN←←6>;PASSWORD CHANNEL
IFN SPLSW,<SPLCHN←←7>;SPOOLER FILE CHANNEL
UPR←←10 ;For getting UFD protection and default protection
CMD←←FI ;command device.
IFN TWO,<
LOC 136
JRST [ MOVE 1,['*COPY*']
CALL 1,['SETNM2']
OUTSTR[ASCIZ/SETNM2 FAILED!
/]
SETO 1,
CALLI 1,36 ;WRITE PROTECT UPPER SEGMENT
OUTSTR[ASCIZ/SETUWP FAILED!
/]
HALT START]
RELOC
>;TWO
LOC 137
1,,1
RELOC
OPDEF TTYUUO[51B8]
OPDEF UINBF[704B8]
OPDEF UOUTBF[705B8]
;this is a macro for non-recoverable error typeout.
DEFINE ERRMES(X)
<TTYUUO 3,[ASCIZ|X
|]
JRST CLRBFI
>;ERRMES
;UUOCON DEVBIT LABEL MFDBUF LUFD SRCH ODEV IDEV LSTDEV CMDDEV DTAIN1 DTAIN2 MFDDEV UDPDEV UFDDEV UPRDEV UPRBLK SPLNAM SPLDEV SPWCMA SPLBLK RQNAM RQJOB FSIZE RQTIME FNAME FEXT FDAT FPPN ANAME AEXT APPN CBITS SPLLEN MAIBUF PASDEV PASNAM CMDLST PASWRD RDOFF OFFSET REALLN WRTOFF SETOFF PAGE DDDDON PAGBUF DPYWRD LPAGBF DDDCMD DDDPOS IIIPOS DMPOS PHONY FCNMAX FCNAM FCEXT FCPPN FCLEN FCPERM FCTMP1 FCTMP2 FCDOIT FCDNAM FCDEXT FCDPPN FCDNUM FCERRM XGPSER FCRESP FONTER ERCODE FCSELB FCSELT FCBITS MARSET ILINES DLINES FULFLG TIMFLG PROFLG UPRFLG UIGFLG BTHRES BIGNLY OFFNLY DMPFLG REFFLG WRIFLG OFFFLG RDRETR RETRBF FREEBL FREBIE NBUFS BKDSIZ PGWAIT
;NON-ZERO DATA LOCS
;welcome to the data area, use it in good health!
↓UUOCON:0
JRST .UUOCN
↓DEVBIT:0
JRST DEVBT1
DEFINE DATA(LABEL,SIZE)
<
LABEL:
IFIDN<SIZE><><0>
IFDIF<SIZE><><BLOCK SIZE>
>;END DATA
MFDBUF: MFDPPN
'UFD '
0
0
LUFD: 0
SIXBIT/UFD/
0
0
SRCH: 'SEARCH'
'LST '
BLOCK 2
ODEV: 0
0
XWD OFIL,0
IDEV: 0
0
XWD ISYS,IFIL
LSTDEV: 0
0
XWD OLST,0
CMDDEV: 0
0
ICMD
DTAIN1: 13
0
IUFD
DTAIN2: 13
0
XWD IUFD,0
MFDDEV: 210
0
IMFD
UDPDEV: 10
0
IUFD
UFDDEV: 210
0
IUFD
UPRDEV: 217
'DSK '
0
UPRBLK: 0
'UFD '
0
0
IFN SPLSW,<
SPLNAM: 0
0
0
'SPLSYS'
SPLDEV: 217
'DSK '
0
SPWCMA: IOWD SPLLEN,SPLBLK
0
SPLBLK: <SIXBIT/NP/>+1
RQNAM: 0 ;PPN OF REQUESTOR
RQJOB: 0 ;XWD LINE #, JOB #
'DSK ' ;DEVICE DISK FOR NOW
0 ;IN MODE 0
FSIZE: 0 ;SIZE OF FILE
RQTIME: 0 ;XWD DATE,TIME OF REQUEST
FNAME: 0 ;NAME
FEXT: 0 ;EXT
FDAT: 0 ;DATE
FPPN: 0 ;PPN
ANAME: 0 ;ALIAS NAME
AEXT: 0 ;ALIAS EXT
APPN: 0 ;ALIAS PPN
CBITS: 0 ;SPOOLER BITS
0 ;REPEAT COUNT
0 ;PAGE SPEC
SPLLEN←←.-SPLBLK
MAIBUF: '[LIST]' ;NAME OF PHANTOM
.+1
0 ;SEND AT LEAST 1 ZERO.
>;SPLSW
IFN PASSSW,<
PASDEV: 217
0
0
PASNAM: BLOCK 4
CMDLST: 'GODMOD'
15 ;INFCOM
0 ;WORD 0 OF THE 5
PASWRD: 0
>;PASSSW
IFN STANSW,<
RDOFF: 'GODMOD'
20
OFFSET: 0
REALLN: 0
WRTOFF: 'GODMOD'
21
SETOFF: 0
>;STANSW
IFN DISPSW,<
PAGE: 602000,,PAGBUF ;Overlapped, DD double-field, DM USERGO modes.
LPAGBF
DDDDON: 0 ;Still going flag, never examined
PAGBUF+1 ;FOR DOUBLE FIELD MODE
PAGBUF: 0
<BYTE(11)600,710>+146
ASCID/Page /
DPYWRD: 1
ASCID /
/ ;CRLF for DD only
0 ;HALT for DD only
LPAGBF←←.-PAGBUF
DEFINE CW(C1,B1,C2,B2,C3,B3)
< <BYTE(8)<B1>,<B2>,<B3>(3)<C1>,<C2>,<C3>>!4>
DDDCMD: CW 1,46,2,0,3,100
DDDPOS: CW 4,1,4,1,5,10
IIIPOS: <BYTE(11)600,710>+146
DMPOS: BYTE (7)177,14,=70≠140,142 ;3rd line, 71st col
>;DISPSW
PHONY: 6 ;MAGTAPE BUFFER SETUP
0
IFN XGPSW,<
FCNMAX←←17 ;MAX NUMBER OF FONT ID'S (STARTING AT 0)
FCNAM: 0 ;FONT FILENAME
FCEXT: 0 ;EXT,,FONT ID
FCPPN: 0 ;PPN
FCLEN←←.-FCNAM
BLOCK FCLEN*FCNMAX ;SPACE FOR TEMP TABLES
FCPERM←←.-FCNAM
BLOCK FCLEN*(FCNMAX+1) ;SPACE FOR PERMANENT TABLES
FCTMP1: BLOCK FCLEN*(FCNMAX+1) ;TEMP BLOCK FOR SCAN STUFF
FCTMP2: BLOCK FCLEN*(FCNMAX+1) ;TEMP BLOCK FOR SCAN STUFF
;FONT SELECT MTAPE BLOCK
FCDOIT: 1 ;SET FONT COMMAND
FCDNAM: 0
FCDEXT: 0
FCDPPN: 0
FCDNUM: 0
;ERROR CODE MTAPE BLOCK
FCERRM: 0 ;ERROR OP-CODE
XGPSER: 0 ;ERROR FROM XGPSER
FCRESP: 0 ;FC RESPONSE
FONTER: 0 ;FONT ERROR CODE
ERCODE: 0 ;ERROR CODE FOR FONT ERROR OF 0 OR 2
FCSELB: 0 ;FONT SELECT BITS
;BIT # CORRESPONDS TO FONT ID
;SELECTED TO OTHER THAN DEFAULT
FCSELT: 0 ;TEMP SEL FOR SELECT CODE
FCBITS:
FOR I←0,FCNMAX
< <400000,,0>⊗-FCNMAX
>
MARSET: 0
BLOCK 5
ILINES: 0
DLINES: 0 ;DEFAULT # OF LINES
>;XGPSW
FULFLG: 0 ;DIRECTORY FLAGS
TIMFLG: 0
PROFLG: 0
UPRFLG: 0
UIGFLG: 0 ;Ignore UFDs protected from us
IFN STANSW,<
BTHRES: 0 ;Threshold for listing big files only, in words
BIGNLY: 0
OFFNLY: 0
DMPFLG: 0
REFFLG: 0
WRIFLG: 0
OFFFLG: 0
RDRETR: 'GODMOD'
14
IOWD DQINFB+2,RETRBF
RETRBF: BLOCK DQINFB+2
FREEBL: 0
FREBIE: 0 ;NON-ZERO IF WANT TO PRINT FREE BLOCK COUNT IN FREEBL
;Next two cells are really set up by initialization from system low-core cell
NBUFS: =19 ;Optimum number of I/O buffers for disk
BKDSIZ: =18*200 ;Size of disk track in data words
>;IFN STANSW
PGWAIT: 0 ;-1 IF WANT TO WAIT BETWEEN PAGELIST ELEMENTS
;ZERO DATA LOCS
IFN STANSW,<
DATA USETP
DATA CUROFF
>;STANSW
IFN UDPSW,<
DATA UIDEV
>;UDPSW
IFN SPLSW,<
DATA SPLBIT
>;SPLSW
IFN HELPSW,<
DATA COLUMN
>;HELPSW
IFN PASSSW,<
DATA LSTPAS
>;PASSSW
IFN PDELSW,<
DATA PDLFLG
>;PDELSW
IFN XGPSW,<
DATA XGPPTR
DATA XGPSWT
>;XGPSW
IFN DEVWAIT,<
DATA IOSSAV
>;DEVWAIT
DATA PPNTMP
DATA SAVCHR
DATA LASTHD
DATA SAVK
DATA TOTALK,3
DATA GTOTAL,3
DATA INFF
DATA OUTFF
DATA UFDFF
DATA NULL,4
DATA DESBUF,7
TERMLN←←.-DESBUF
DATA DESTIN,TERMLN
DATA DESTMP,TERMLN
DATA ICMD,0
DATA OLST,3
DATA LPTHD,14
DATA OBUF,4
IFN STANSW,<BLOCK 2>
DATA SOURCE,4
IFN STANSW,<BLOCK 2> ;FOR LONG LOOKUP BLOCK
DATA ISYS,3
DATA IMFD,3
DATA IUFD,3
DATA IFIL,3
DATA OFIL,3
DATA PSHDWN,PDL
DATA STACK
DATA YY
DATA XX
DATA QQ
DATA GG
DATA ZZ
DATA LSTCHR
DATA AT
DATA NAMGEN
DATA EXTGEN
DATA OUTDEV
DATA DFTSWT
DATA C.LAST
IFN SENDSW,<
DATA MESEXT
DATA MESFLG
>
DATA LASTOUT
DATA CMDGET
DATA DFTDEV
DATA DFTPPN
DATA DFTLIN
DATA OMOD
DATA SAVPGL
DATA NDSTRM
DATA NOFLAG
DATA DFTPRO
DATA SAVEND
DATA ALTDEV
DATA SAVLIN
DATA SAVPPN
DATA SAVDEV
DATA SAVSWT
DATA SAVPRO
DATA SAVPC
DATA CHRCNT
DATA PNTR
DATA CNTR
DATA GOPAGE
DATA LOGPG
DATA PHYPG
DATA LPTPTR
DATA LCHCNT
DATA LINCNT
DATA NSPACE
DATA STAR
DATA DEVTMP
DATA UCHN
IFN TWO,<RELOC 400000>
;↓CLRBFI CLRBF1 CLRBF2 CLRBF3 CHRMS2 ILL1 WRDM2 RECOV CKDIR CKNAME NORMFL UFDFIL PERIOD SYSCHK DEVBT1 FCREST FCCLR FCCLR1 FCERRP XGPTAB ILSCOD XCODEP XCODEQ FCERR1 FCRTAB ILFCOD FNTER1 FNTTAB ILFCCD ILFCCM FCLKER
;ERROR SUBRS -- CLRBFI, CHRMES, ILLDEV, WRDMES, RECMES, FONT CODE
↓CLRBFI:MOVEI T,6 ;print next six char.in line.
CLRBF1: MOVE [TYI]
CAME CMDGET
JRST [ XCT CMDGET
JRST CLRBF2]
INCHSL BRK ;anything there?
JRST CLRBF3
CLRBF2: OUTCHR BRK ;output char
SOJG T,CLRBF1 ;loop
CLRBF3: JUMPE BRK,DIE ;if brk 0 then no extra crlf.
OUTSTR [ASCIZ/
/] ;crlf
TTYUUO 11, ;clear input buffer
JRST DIE
;Illegal character message.
DEFINE CHRMES(X)
<MOVEI WRD,[ASCIZ\ X
\] ;point wrd at string
JRST CHRMS2
>;CHRMES
CHRMS2: TTYUUO 1,[42] ;"
TTYUUO 1,BRK ;char
TTYUUO 1,[42] ;"
TTYUUO 3,@WRD ;string
JRST CLRBFI
;This is a macro for illegal device messages.
DEFINE ILLDEV (X)
<TTYUUO 3,[ASCIZ/Device /]
SIXOUT DESBUF ;device name
TTYUUO 3,[ASCIZ\ X
\] ;message
JRST CLRBFI
>;ILLDEV
ILL1: ILLDEV(illegal.)
DEFINE WRDMES(X)
<MOVEI BRK,[ASCIZ@ X
@] ;message
JRST WRDM2
>;WRDMES
WRDM2: MOVEM BRK,OMOD ;stupid poole
PUSHJ P,SIXOU1 ;word already in wrd.
TTYUUO 3,@OMOD ;message
JRST CLRBFI
;This macro allows us to recover from an error.
DEFINE RECMES(X,Y,Z,QS,G)
<MOVE Y
MOVEM YY
MOVEI [ASCIZ\X\]
MOVEM XX
MOVEI [ASCIZ\QS\] ;these setup the parameters
MOVEM QQ
IFIDN <G> <> <SETZM GG>
IFDIF <G> <> <HRREI G
MOVEM GG>
MOVEI Z
JRST RECOV >;RECMES
RECOV: MOVEM ZZ
EXCH T,ZZ ;SAVE T, GET FILE POINTER
TTYUUO 13, ;INSKIP TURNS OFF ↑O.
JFCL ;IGNORE THIS RETURN
TTYUUO 3,@XX ;give error.
SIXOUT YY ;device.
SKIPE YY ;no : if no dev.
TTYUUO 1,[":"] ;
MOVE YY ;get device.
JSR DEVBIT ;GET ITS CHARACTERISTICS
TLNN MTADEV
JRST CKDIR
MOVE YY
CAME IDEV+1 ;SAME AS INPUT DEVICE?
JRST [ MOVE DESTIN+1
JRST .+2]
MOVE TSWTCH
TRNE SAV ;SAVE FORMAT MAGTAPE?
JRST CKNAME ;YES, CHECK FOR NON-ZERO NAME
JRST PERIOD
CKDIR: TLNE DIRDEV ;test.
CKNAME: SKIPN (T) ;test filnam.
JRST PERIOD ;THAT'S ALL
HLRZ 1(T) ;GET EXT
CAIE 'UFD' ;IS IT UFD?
JRST NORMFL ;NO
MOVE YY
JSR DEVBIT
TLNN UDEV!DSKDEV
JRST NORMFL
MOVE 3(T) ;PPN
CAME [MFDPPN] ;1,1?
JRST NORMFL
TTYUUO 1,["["]
PPNOUT (T)
TTYUUO 1,["]"]
JRST UFDFIL
NORMFL: SIXOUT (T) ;filename
UFDFIL: HLLZ 0,1(T) ;ext.
SKIPE 0 ;skip if none.
TTYUUO 1,["."] ; "."
SIXOUT 0 ;ext out.
MOVE YY ;dev.
JSR DEVBIT ;GET ITS CHARACTERISTICS
TLNN UDEV!DSKDEV ;disk.
JRST PERIOD ;end if not disk.
TTYUUO 1,["["] ;yes.
PPNOUT 3(T) ;print ppn.
TTYUUO 1,["]"]
PERIOD: MOVE T,ZZ ;RESTORE T
MOVE GG
CAIE 1 ;SPECIAL INHIBIT CRLF SWITCH
TTYUUO 3,[ASCIZ/.
/]
TRNN TSWTCH,S ;/SEARCH ?
TLNE TSWTCH,NOANS ;or answer not nescessary?
JUMPE SPOPJ1 ;then assume "yes" answer if non-fatal.
TRNE TSWTCH,Q ;/QUIET ?
JUMPE SPOPJ1 ;then assume "yes" answer if non-fatal.
TTYUUO 11, ;clear input buffer
TTYUUO 3,@QQ ;solution.
TTYUUO 0,0 ;answer.
MOVEM 0,LSTCHR ;SO IT CAN BE LOOKED AT BY THE HIGHER UPS
TTYUUO 3,[ASCIZ/
/]
ANDI 0,177 ;discard bucky bits before testing
CAIE 0,171
CAIN 0,131
AOS (P) ;he said yes, inc return.
TTYUUO 11,
POPJ P,
SYSCHK: MOVEM T,IDEV+1
JSR T,DEVBIT ;DEVCHR
TLNN T,DSKDEV ;IS IT A DISK?
POPJ P, ;NO
MOVEI T,17
MOVEM T,IDEV ;DON'T GET ANY BUFFERS
OPEN SYSCHN,IDEV
POPJ P, ;BLOW THE HOLE THING IF NOT AVAILABLE
CHNSTS SYSCHN,T ;GET CHANNEL STATUS
RELEASE SYSCHN,
TRNN T,SYSDEV
POPJ P,
JRST SPOPJ1 ;YES, IT IS!
DEVBT1: MOVEM T,DEVTMP
MOVE T,DEVBIT
LDB T,[POINT 4,-1(T),12]
CAIN T,T
MOVEI T,DEVTMP ;STORE INTO SAV LOC IF T
MOVEM T,UCHN ;AC NUMBER
MOVE T,@UCHN ;PICKUP DEVICE NAME
CALLI T,4
IFN XGPSW,<
TLZE T,XGPDEV ;THIS IS REALLY DVLNG BIT
TLZN T,LPTDEV ;IS IT LPT ALSO?
CAIA
TLO T,XGPDEV ;REALLY XGP
>;XGPSW
TLZ T,NULHAK
EXCH T,@UCHN ;DISGUSTING CODE DESERVES THIS DISGUSTING
PNAME T, ;WAY TO MAKE NUL: WORK.
SETZ T,
CAMN T,['NUL ']
SKIPA T,[NULHAK,,0]
SETZ T,
IORM T,@UCHN
MOVE T,DEVTMP
JRST @DEVBIT
IFN XGPSW,<
FCREST: MOVE T,[FCNAM+FCPERM,,FCNAM]
BLT T,FCNAM+FCPERM-1 ;COPY PERMANENT TABLES INTO TEMPORARY ONES
POPJ P,
FCCLR: SETZM FCNAM+FCPERM
MOVE T,[FCNAM+FCPERM,,FCNAM+FCPERM+1]
BLT T,FCNAM+FCPERM+FCPERM-1 ;ZERO TABLE
MOVEI T,FCLEN*17
MOVEI T2,17
FCCLR1: MOVEM T2,FCEXT+FCPERM(T)
SUBI T,FCLEN
SOJG T2,FCCLR1
POPJ P,
FCERRP: MTAPE FO,FCERRM ;GET ERROR CODES
SKIPL T,XGPSER ;PICKUP AND CHK XGPSER ERROR CODE
CAILE T,XGPMAX
HRLZ T,T ;MAKE INDEX 0, SAVE ILL CODE IN LEFT HALF
XCT XGPTAB(T)
OUTSTR[ASCIZ/.
/]
POPJ P,
;WORD 1 OF ERROR BLOCK
XGPTAB: PUSHJ P,ILSCOD ;ILLEGAL SYSTEM CODE
OUTSTR[ASCIZ/Not enough jobs for FC/]
OUTSTR[ASCIZ/No initial response from FC/]
OUTSTR[ASCIZ/No intermediate response from FC/]
PUSHJ P,FCERR1
OUTSTR[ASCIZ/I-level data missed/]
OUTSTR[ASCIZ/Hung timeout/]
OUTSTR[ASCIZ/Illegal data mode/]
XGPMAX←←.-XGPTAB-1
ILSCOD: OUTSTR[ASCIZ/Unknown system error, code = /]
XCODEP: HLRE T,T
XCODEQ: SKIPGE T
OUTCHR["-"]
MOVM T,T
JRST R10TTY
FCERR1: SKIPL T,FCRESP
CAILE T,FCRMAX
HRLO T,T ;SAVE CODE, MAKE INDEX -1
XCT FCRTAB(T)
POPJ P,
;WORD 2 OF ERROR BLOCK
JRST ILFCOD
FCRTAB: OUTSTR[ASCIZ/Unexpected ready response from FC/]
OUTSTR[ASCIZ/Unexpected allocation made response from FC/]
OUTSTR[ASCIZ/Unexpected font OK response from FC/]
JRST FNTER1
FCRMAX←←.-FCRTAB-1
ILFCOD: OUTSTR[ASCIZ/Unknown FC error, code = /]
JRST XCODEP
FNTER1: SKIPL T,FONTER
CAILE T,FNTMAX
HRLO T,T ;SAVE CODE, MAKE INDEX -1
XCT FNTTAB(T)
POPJ P,
;WORD 3 OF ERROR BLOCK
JRST ILFCCD
FNTTAB: JRST ILFCCM
OUTSTR[ASCIZ/FC too big/]
JRST FCLKER
OUTSTR[ASCIZ/File error (unexpected EOF)/]
OUTSTR[ASCIZ/File error (multiply defined character code)/]
OUTSTR[ASCIZ/File error (IO error)/]
OUTSTR[ASCIZ/Font ID # too big/]
OUTSTR[ASCIZ/Illegal font file format/]
FNTMAX←←.-FNTTAB-1
ILFCCD: OUTSTR[ASCIZ/Unknown font error, code = /]
JRST XCODEP
ILFCCM: OUTSTR[ASCIZ/Illegal font command code, code = /]
MOVE T,ERCODE
JRST XCODEQ
FCLKER: OUTSTR[ASCIZ/Font file LOOKUP failure, /]
SKIPL T,ERCODE ;WORD 4 OF ERROR BLOCK
CAILE T,MAXERR-1
MOVEI T,UNERR-ERRTAB
OUTSTR @ERRTAB(T)
POPJ P,
>;XGPSW
;.UUOCN UUOCN1 DISTAB SEV1 SIXO1 SIXS1 PPNO1 PPNS1
;UUO HANDLER
IFE RETSW,<REE:MOVE BRK,JOBOPC ;get old pc.
TLNE BRK,10000 ;were we in user mode.
JRST [ MOVE WRD,(BRK) ;yes, get io uuo.
MOVEI 10 ;error code for bad retrieval.
HRRM 1(WRD) ;to buffer
JRST 1(BRK)] ;impersonate error return from uuo with bad retrieval.
PUSHJ P,[RECMES(Bad retrieval from ,['DSK '],@WRD,Type Y to go on.)]
JRST QUIT
POPJ P,
>;RETSW
.UUOCN: PUSH P,UUOCON ;make it look like pushj
MOVEM 16,17(P) ;SAVE 16
HRRZI 16,1(P)
BLT 16,16(P) ;BLT AC'S ONTO STACK(EXCEPT P).
ADD P,[XWD 17,17] ;ADJUST P.
JUMPGE P,[ OUTSTR[ASCIZ/PDL OV AT UUOCON
/]
HALT .+1]
PUSHJ P,UUOCN1 ;do UUO.
SOS -17(P) ;direct return.
CAIA ;skip return.
AOS -17(P) ;double skip return.
AOS -17(P)
HRLZI 16,-16(P)
BLT 16,16
SUB P,[XWD 17,17]
POPJ P,
UUOCN1: MOVEM T,AT
LDB T,[POINT 9,UUO,8] ;get OP-CODE
MOVE T,DISTAB-1(T)
EXCH T,AT
JRST @AT
DISTAB:
SIXO1
SIXS1
SEV1
PPNO1
PPNS1
IFN UDPSW,<FOR A IN (OUTUDP,INUDP,LOKUDP,ENTUDP,RENUDP,OPNUDP,CLSUDP,UDPM2)
<A
> >;UDPSW
SEV1: MOVEI WRD,@UUO
JRST SEVST1
SIXO1: MOVE WRD,@UUO
JRST SIXOU1
SIXS1: MOVE WRD,@UUO
JRST SIXST1
PPNO1: MOVE WRD,@UUO
JRST PPNOU1
PPNS1: MOVE WRD,@UUO
JRST PPNST1
;START SCNAGN SCAN2 SCAN3
;INIT SYSTEM SCAN
;This section does the scan and puts the input term in a buffer starting
;at STACK. You die here if there is anything wrong with the input string.
;The output term is in destin.
;the output device will be in odev+1.
;and the listing term (if any) is in srch.
;the listing device will be in lstdev+1.
START: JFCL ;TDZA ALT,ALT ;somewhere over the rainbow
SETO ALT, ;this means we were started by system.
CALLI 0 ;reset the world
MOVE JOBFF ;end of world.
CALLI 11 ;shrink world
JRST 4,.+1 ;oops!
SETZ TSWTCH, ;zero switchword.
MOVE [TYI] ;start input from tty
MOVEM CMDGET ;to xct loc.
MOVE ['AAAAA@'] ;initial filename for
MOVEM NAMGEN ;generated filenames.
MOVSI 'COP' ;generated ext.
MOVEM EXTGEN ;to mem.
MOVSI 'DSK' ;default device
MOVEM DFTDEV ;to memory.
MOVEM OUTDEV ;DEFAULT OUTPUT DEVICE
IFN STANSW,<
MOVEI 0,346 ;System low-core address of cell containing
PEEK 0, ; useful disk parameters; get parameters.
HLRZM 0,NBUFS ;Remember ideal number of disk buffers for WAITS
HRRZM 0,BKDSIZ ;Remember disk track size in data words
>;IFN STANSW
SETZM DDDDON ;Clear DD program running flag
SETZM DFTPPN ;obvious
SETZM DFTSWT ;zero sticky switch storage.
SETZM DFTPRO
SETZM DFTLIN
IFN UDPSW,<SETZM UIDEV>
MOVE P,[IOWD PDL,PSHDWN] ;initialize pushj pointer.
IFN XGPSW,<PUSHJ P,FCCLR>
JUMPE ALT,REMOD ;SYSTEM START?
TTYUUO 10, ;reset pointer to beginning of line.
SCNAGN: PUSHJ P,GETWRD ;get first word in line.
SETZB T,ALT ;zero t,ALT
HRLZI T2,770000 ;make a sixbit char. mask.
TDNN WRD,T2 ;test wrd.
JRST LFCHK ;no word.
SCAN2: TDO T,T2 ;extend mask to chars. tested so far.
LSH T2,-6 ;move test mask to right one char.
TDNE WRD,T2 ;test for char.
JUMPN T2,SCAN2 ;if still in word go extend mask.
MOVEI T2,SCNLST ;point to command list.
SCAN3: MOVE T3,T ;get mask.
AND T3,(T2) ;get proper number of letters from command list.
CAMN WRD,(T2)
JRST SCNTAB-SCNLST(T2) ;EXACT MATCH
CAMN WRD,T3 ;compare with command typed in.
JRST [ JUMPN ALT,[CERR:ERRMES(Command error.)] ;more than one match, bad.
MOVE ALT,T2 ;put pointer to command in t6.
JRST .+1] ;back to main stream.
CAIGE T2,ENDSCN-1 ;end of command list?
AOJA T2,SCAN3 ;no, inc. pointer and go back.
JUMPE ALT,LFCHK ;NO COMMAND FOUND!
JRST SCNTAB-SCNLST(ALT) ;use switch list pointer to get to proper routine.
;SCNTAB SCNLST
;SYSTEM COMMAND TABLE
SCNTAB:
JRST LFCHK ;S
JRST LFCHK ;R
JRST SYSMOD ;COPY
JRST [ MOVEI K!L ;TRANSFER
MOVEM DFTSWT
JRST SYSMOD]
JRST [ MOVEI RE ;RENAME
MOVEM DFTSWT
JRST SYSMOD]
JRST [ MOVEI RE!L ;DELETE
MOVEM DFTSWT
TLO TSWTCH,DELSWT
JRST SYSMOD]
JRST [ MOVEI S!L ;DIRECTORY
MOVEM DFTSWT
TLO TSWTCH,DIRSWT
MOVSI 'LPT'
MOVEM LSTDEV+1
JRST SYSMOD]
JRST [ MOVSI 'LPT' ;PRINT
MOVEM OUTDEV
MOVEI N!TT
MOVEM DFTSWT
JRST SYSMOD]
JRST [ MOVSI 'TTY' ;TYPE
MOVEM OUTDEV
JRST SYSMOD]
JRST [ MOVSI 'LPT' ;LIST
MOVEM OUTDEV
MOVSI H
MOVEM DFTPRO
JRST SYSMOD]
IFN SENDSW,<
JRST [ TLO TSWTCH,SNDSWT ;SEND
JRST SYSMOD]
>;SENDSW
IFN HELPSW,<
JRST [ TLO TSWTCH,HLPSWT ;HELP
JRST SYSMOD]
>;HELPSW
IFN XGPSW,<
JRST [ MOVSI 'XGP' ;XGPLIST
MOVEM OUTDEV
JRST SYSMOD]
>;XGPSW
SCNLST: 'S '
'R '
'COPY ' ;system command list.
'TRANSF'
'RENAME'
'DELETE'
'DIRECT'
'PRINT '
'TYPE '
'LIST '
IFN SENDSW,<'SEND '
>;SENDSW
IFN HELPSW,<
'HELP '
>;HELPSW
IFN XGPSW,<
'XGPLIS'
>;XGPSW
ENDSCN←←.
;LFCHK1 LFCHK SCNOUT REMOD SYSMOD
;INIT COMMAND LINE SCAN
LFCHK1: TTYUUO 2,BRK
JRST REMOD ;NO MORE CHARS
LFCHK: CAIN BRK,12 ;IF END OF LINE, NO CLRBFI
JRST REMOD ;NO CLRBFI
CAIN BRK,";" ;THIS IS SPECIAL
JRST SCNAGN ;KEEP LOOKING
IFE DECSW,<TRNE BRK,600
JRST SCNOUT
>;DECSW
CAIE BRK,ALTMOD
JRST LFCHK1
SCNOUT: TTYUUO 11, ;clear input buffer.
REMOD: TLO TSWTCH,RUNMOD ;started by loser
TTYUUO 3,[ASCIZ/*/] ;give user a "*".
MOVEI BRK," " ;FOR FIRST SCAN
TLZ TSWTCH,-1≠RUNMOD ;turn off special switches.
MOVE [TYI] ;get input from tty.
MOVEM CMDGET
SETZM DFTSWT ;zero default switches.
SETZM DFTPRO
SETZM DFTLIN
SETZM DFTPPN
SETZM PROFLG ;ZERO THE DIRECTORY SWITCHES
SETZM TIMFLG
SETZM FULFLG
SETZM UPRFLG
SETZM UIGFLG
IFN STANSW,<
SETZM BTHRES
SETZM BIGNLY
SETZM OFFNLY
SETZM DMPFLG
SETZM REFFLG
SETZM WRIFLG
SETZM OFFFLG
SETZM FREBIE ;NO FREE BLOCK COUNT WANTED YET
>;STANSW
SETZM PGWAIT
MOVSI 'DSK' ;default device
MOVEM DFTDEV ;to memory.
MOVEM OUTDEV
IFN UDPSW,<SETZM UIDEV>
IFN XGPSW,<PUSHJ P,FCCLR>
SYSMOD: HLLZS TSWTCH ;zero right half of switchword.
TLZ TSWTCH,PLSMOD!LSTSWT ;turn off certain switches in left half.
MOVE DFTSWT ;get any special switches.
TRNE S!L ;searching?
TLO TSWTCH,LSTSWT ;yes.
IFN PDELSW,<SETZM PDLFLG>
IFN SPLSW,<SETZM SPLBIT ;clear spooler bits>
SETOM OMOD ;double mode checker.
TLO TSWTCH,TTYSWT ;ttyuuo listing switch.
SETZM DESTIN ;first term switch.
MOVE P,[IOWD PDL,PSHDWN] ;initialize pushj pointer.
MOVE STK,JOBFF ;initialize stack pointer
MOVEM STK,STACK ;remember top
AOS STACK
IFN SENDSW,<TLNE TSWTCH,SNDSWT ;SEND?
JRST MESMAK ;special setup
>;SENDSW
IFN HELPSW,<
TLNE TSWTCH,HLPSWT
JRST HLPCOM ;HELP HIM.
>;HELPSW
;BUNCH
;SCAN DEST, LIST TERMS
SETZM SAVPGL
IFN XGPSW,<SETZM XGPSWT> ;CLEAR FLAG SAYING SEEN XGP SWITCH
CAIE BRK," "
JRST [ SETZ WRD, ;any of the preceeding get us here.
PUSHJ P,TERM1 ;SKIP FIRST PUSHJ TO GETWRD
JRST BUNCH] ;BACK IN LINE
PUSHJ P,TERM ;get term
BUNCH: CAIN BRK,12 ;LF?
JRST [ TLNN TSWTCH,DIRSWT ;IF DIR,
TLNN TSWTCH,NULFLG ;OR NOT NULL TERM
JRST [ PUSHJ P,DFTTRM ;THEN DO DEFAULT THING
JRST DETERM+1]
TLNE TSWTCH,RUNMOD ;GIVE HIM STAR, OR GIVE HIM SHIT?
JRST REMOD
ERRMES(<COPY what?>)]
MOVE T,[XWD DESBUF,DESTIN]
BLT T,DESTIN+6 ;blt term into destin.
IFN XGPSW,<MOVE T,[XWD FCNAM,FCTMP1]
BLT T,FCTMP1+FCPERM-1 ;SAVE THIS TERMS FONTNAMES HERE
>;XGPSW
CAIE BRK,"←"
CAIN BRK,"="
JRST GETDST ;GO DO DESTINATION TERM.
CAIE BRK,","
JRST [ILLBRK:CHRMES(Illegal where used.)]
SETZM NDSTRM
SETZM NOFLAG ;REMEMBER STATE OF NO FILE FLAG
TLNE TSWTCH,NULFLG
SETOM NDSTRM ;null destination term flag.
TLNE TSWTCH,NOFIL
SETOM NOFLAG
IFN XGPSW,<SETZM XGPSWT> ;NO XGP SWITCHES SEEN YET
PUSHJ P,TERM ;get term
CAIE BRK,"←" ;is this list term
CAIN BRK,"=" ; "
JRST GETLST ;GO DO LIST TERM
CAIE BRK,12
CAIN BRK,","
CAIA
JRST ILLBRK
MOVE T,[XWD DESBUF,DESTMP] ;BOTH INPUT TERMS, SAVE SECOND ONE
BLT T,DESTMP+TERMLN-1
MOVE T,[XWD DESTIN,DESBUF] ;GET FIRST INTO RIGHT PLACE
BLT T,DESBUF+TERMLN-1
IFN XGPSW,<
MOVE T,[XWD FCNAM,FCTMP2] ;SAVE THIS GUY HERE
BLT T,FCTMP2+FCPERM-1
MOVE T,[XWD FCTMP1,FCNAM]
BLT T,FCNAM+FCPERM-1
>;XGPSW
MOVE OUTCHR,OUTDEV
TLNE TSWTCH,DELSWT
MOVE OUTCHR,DESBUF
JSR OUTCHR,DEVBIT ;GET CHARACTERISTICS
PUSH P,TSWTCH
TLZ TSWTCH,NOFIL
SKIPE NOFLAG
TLO TSWTCH,NOFIL
PUSHJ P,MAKTRM ;make first term a source term
POP P,T
TLZ TSWTCH,NOFIL
TLNE T,NOFIL
TLO TSWTCH,NOFIL
MOVE [XWD DESTMP,DESBUF]
BLT DESBUF+TERMLN-1 ;now get second term back
IFN XGPSW,<
MOVE T,[XWD FCTMP2,FCNAM]
BLT T,FCNAM+FCPERM-1
>;XGPSW
PUSHJ P,DFTTRM
JRST DETERM+1 ;make desbuf a source term
;GETLST LSTTRM LSTAGN GETDST DTERM1 DETERM
;LIST TERM, SCAN SOURCE TERMS
GETLST: MOVEI T,0
JBTSTS T,
TLNE T,10000 ;NO DEST OR LIST TERMS W/O LOGIN
TLNE TSWTCH,DIRSWT
JRST [ILLTRM:ERRMES(Illegal term.)] ;directory uses destination term for listing term.
TLNE TSWTCH,DELSWT
JRST ILLTRM
PUSHJ P,DESTRM ;make destination term
LSTTRM: TLNE TSWTCH,NULFLG ;must type something.
JRST NSTAR
TLZ TSWTCH,TTYSWT ;not on tty(or on tty and full info.)
LSTAGN: MOVE T2,DESBUF ;device
MOVEM T2,LSTDEV+1 ;to mem loc
JSR T2,DEVBIT ;GET DEVCHR
TLNN T2,LEGDEV-UDEV ;legal device? (CAN'T LIST ON UDP)
IFE SPLSW,<JRST ILL1>
IFN SPLSW,<JRST [MOVEI WRD,DESBUF
PUSHJ P,SETSPL
MOVSI T2,2(T2) ;ADD ALIAS BIT
HLLM T2,SPLBIT ;ALIAS NAME FLAG
JRST LSTAGN]
>;SPLSW
TLNN T2,1
JRST [ILL2:ILLDEV(cannot do output.)]
IFN XGPSW,<
TLNE T2,XGPDEV
JRST [ERRMES(<Sorry, XGP as listing device is a bad idea!>)]
SKIPE XGPSWT
JRST [ERRMES(<XGP switches illegal for LIST term!>)]
>;XGPSW
TLNN T2,DIRDEV
JRST DTERM1 ;not directory device, no filename check
MOVE T,DESBUF+4
TRNE T,NAMSTR!EXTSTR!PSTR!PNSTR ;ANY STARS?
JRST [NSTAR:ERRMES("*" illegal in LIST term.)]
HLLZ T,DESBUF+2
MOVEM T,SRCH+1 ;ext.
MOVE T,DESBUF+1
MOVEM T,SRCH ;stow it
MOVE T,DESBUF+3
MOVEM T,SRCH+3
IFN SPLSW,<
MOVE WRD,DESBUF+4 ;PICK UP FLAGS
PUSH P,OUTCHR
MOVE OUTCHR,T2
PUSHJ P,SPOCHK ;CHECK DEVICE
POP P,OUTCHR
MOVS WRD,WRD
IORM WRD,SPLBIT ;SAVE BITS IN CORE
>;SPLSW
JRST DTERM1 ;continue scan
GETDST: MOVEI T,0 ;GET OUR JBTSTS
JBTSTS T,
TLNN T,10000 ;NO DEST TERM ALLOWED IF JLOG OFF
JRST ILLTRM
TLNN TSWTCH,DIRSWT
TLNE TSWTCH,DELSWT
JRST [ PUSHJ P,DFTTRM ;MAKE DESTINATION TERM INTO LIST TERM
JRST LSTTRM] ;FOR DELETE OR DIRECTORY
PUSHJ P,DESTRM
DTERM1: MOVSI 'DSK' ;default device.
MOVEM DFTDEV
SETZM DFTPPN ;default ppn.
DETERM: PUSHJ P,TERM ;get next term
PUSHJ P,MAKTRM
CAIN BRK,"," ;legal end for descriptor?
JRST DETERM ;yes, next.
CAIE BRK,12 ;end of line?
JRST ILLBRK
JRST DOIT
;DFTTRM SETSPL ISXGP LPTAGN DESTRM SPOCHK
;DFTTRM, DESTRM, SETSPL
DFTTRM: MOVE OUTCHR,OUTDEV ;USE DEFAULT OUTPUT DEVICE
TLNE TSWTCH,DELSWT ;FOR DELETE
MOVE OUTCHR,DESBUF ;use device in destin
MOVEM OUTCHR,ODEV+1 ;to output device loc
HRROM ODEV ;flag odev
SETZB DESTIN+5
TLNN TSWTCH,DELSWT
MOVSI '* '
MOVEM DESTIN ;to filename
MOVEM DESTIN+1 ;to ext
MOVE T,OUTCHR ;GET DEVICE NAME
PUSHJ P,SYSCHK ;CHECK SYSDEV
TDZA T,T
MOVE T,[' 1 3']
MOVEM T,DESTIN+3
TLNE TSWTCH,DELSWT
TDZA
MOVEI NAMSTR!EXTSTR
MOVEM DESTIN+4
JSR OUTCHR,DEVBIT
TLNN OUTCHR,LEGDEV ;MAKE SURE NO ONE IS CHEATING
JRST ILL1
TLNN OUTCHR,1
JRST ILL2
POPJ P,
IFN SPLSW,<
SETSPL: MOVS T,(WRD)
CAIN T,'PGX'
JRST ISXGP
CAIE T,'TPL'
JRST ILL1
TDZA T2,T2
ISXGP: MOVEI T2,4 ;THIS BIT IN SPLBIT FOR XGP
MOVSI T,'DSK'
MOVEM T,(WRD)
MOVE T,4(WRD)
TDNE T,[XWD BIN,SPLSWT!SPDSWT]
JRST ILRSPL
TRC T,NAMSTR!EXTSTR
SKIPN 3(WRD)
TRNE T,NAMSTR!EXTSTR!PSTR!PNSTR
JRST [ERRMES(Can't use names with device "TPL"!)]
TRO T,SPLSWT!SPDSWT ;SPOOL AND DELETE FILE
MOVEM T,4(WRD)
MOVE T,['SPLSYS']
MOVEM T,3(WRD)
HRRZ T,2(WRD)
TRNE T,O!RE!BLK
JRST [ILRSPL:ERRMES(Illegal switches for device "SPL"!)]
TRO T,A ;SET ASCII
HRLI T,'LPT'
MOVEM T,2(WRD)
CALLI T,22
MOVEM T,1(WRD)
CALLI T,14
HRLM T,1(WRD)
CALLI T,30
DPB T,[POINT 6,1(WRD),5]
MOVE T,3(WRD)
MOVEM T,SPLNAM
PUSHJ P,CHK100 ;CHECK FOR LOGGED IN.
MOVSI 'LPT'
MOVEM SPLNAM+1
OPEN SPLCHN,SPLDEV
JRST [ERRMES(Can't get disk for name check of "LPT" file!)]
LPTAGN: AOS T,1(WRD)
MOVEM OUTCHR,SPLNAM
LOOKUP SPLCHN,SPLNAM
CAME SPLNAM+1 ;0 CONTAINS 'LPT ' CHECKS FOR NOT FOUND RETURN
JRST LPTAGN
RELEASE SPLCHN,
POPJ P,
>;SPLSW
DESTRM: MOVE OUTCHR,DESTIN ;get device
MOVEM OUTCHR,ODEV+1 ;to mem loc
JSR OUTCHR,DEVBIT
TLNN OUTCHR,LEGDEV ;legal device?
IFE SPLSW,<JRST ILL1>
IFN SPLSW,<
JRST [ MOVEI WRD,DESTIN
PUSHJ P,SETSPL
TRO T2,1 ;ADD ALIAS BIT
HRRM T2,SPLBIT ;STO BITS
JRST DESTRM]
>;SPLSW
TLNN OUTCHR,1 ;output device?
JRST ILL2
HRRZ DESTIN+5
MOVEM DFTLIN ;SET DEFAULT /EXTRA=
HRRZS SAVLIN ;CLEAR OVER INDIRECT
MOVE T,DESTIN+1 ;save
MOVEM T,DESTIN ;destination
MOVE DESTIN+2 ;term
MOVEM DESTIN+1 ;in destin., save output switches here also
TRNE S ;output term is rediculous for /SEARCH
JRST [ ERRMES(Don't use destination term with /SEARCH.)]
TDZ [-1,,DSTNLY] ;clear i/o switches, so input may be different
IORM DFTSWT ;and sticky ones
MOVEI 777777≠DSTNLY ;GET COMPLIMENT
ANDM SAVSWT ;CLEAR SWITCHES OVER INDIRECT
MOVE [DSTPRO]
ANDCAM SAVPRO
ANDCA DESTIN+4
MOVEM DFTPRO ;default protection.
SKIPE DESTIN+6
JRST [SYNERR:ERRMES(Syntax error.)]
SETOM ODEV ;flag odev
MOVE WRD,DESTIN+4
TRNN WRD,NAMSTR!EXTSTR!PSTR!PNSTR
TLO TSWTCH,PLSMOD ;plus mode switch.
IFN XGPSW,<
MOVE T,[XWD FCTMP1,FCNAM+FCPERM]
BLT T,FCNAM+FCPERM+FCPERM-1 ;MAKE ALL FONTS SO FAR STICKY
>;XGPSW
IFN SPLSW,<
PUSHJ P,SPOCHK
IORM WRD,SPLBIT
>;SPLSW
POPJ P,
IFN SPLSW,<
SPOCHK: ANDI WRD,SPLSWT!SPDSWT
JUMPE WRD,CPOPJ
TLNE OUTCHR,DSKDEV
POPJ P,
ERRMES(Spooler input must be disk file!)
>;SPLSW
;MAKTRM MAKTR4 ISPOK
;MAKTRM
MAKTRM:
MOVE DEVCHR,DESBUF ;load input device
JSR DEVCHR,DEVBIT
TLNN DEVCHR,LEGDEV ;legal device?
JRST ILL1
IFN UDPSW,<MOVE T,DESBUF
TLNE DEVCHR,UDEV ;A UDP?
MOVEM T,UIDEV ;YES, FLAG IT!
>;UDPSW
TLNN DEVCHR,2 ;input device?
JRST [ILLDEV(cannot do input.)]
HRRZ T,DESBUF+2
TRNN T,RE ;CHECK FOR SAME DEVICES FOR RENAME
JRST MAKTR4
TLNN DEVCHR,DSKDEV!UDEV!DTADEV ;MUST BE ONE OF THESE
JRST [ ILLDEV(illegal for RENAME!)]
MOVE T,DEVCHR
XOR T,OUTCHR
TLNE T,DSKDEV!UDEV!DTADEV ;SHOULD BE THE SAME
JRST [ERRMES(Use same devices for RENAME!)]
MAKTR4: HRRZ T,DESBUF+2 ;get sticky switches
MOVE PRO,DESBUF+4
IFN SPLSW,<
TRNE PRO,SPLSWT!SPDSWT ;ANY SPOOLER SWITCHES HERE?
JRST ILLCOM ;YES, NOT IN SOURCE CHARLY!
>;SPLSW
IFN XGPSW,<
TLNN OUTCHR,XGPDEV
TRNN PRO,ISPACE
JRST ISPOK
ERRMES(<Sorry, interline spacing available on XGP only!>)
ISPOK:
>;XGPSW
TLNE TSWTCH,NOFIL ;NO FILENAME TYPED?
TRNE T,S ;and not /S
JRST WINNFL
TLNN DEVCHR,DIRDEV ;and directory device.
JRST WINNFL
ERRMES(<Sorry, must give file name.>)
WINNFL: TRNE T,-1≠(RE!L!IMAGE!Q!EVEN!D800);ANYTHING BUT THESE
TLNN TSWTCH,DELSWT ;ARE ILLEGAL FOR DELETE.
CAIA
JRST ILLCOM
TLNE TSWTCH,DELSWT ;DELETE IS SPECIAL
TLNN DEVCHR,DSKDEV ;DISK HAS RESTICTIONS ON PPN
JRST PPNOK
IFN PDELSW,<
TRNE TSWTCH,Q ;IS HE ASKING FOR SILENCE
JRST PPNOK ;YES, BE SILENT
TLNN PRO,ASK ;IS ASKING
SKIPE T3,DESBUF+3 ;OR EXPLICIT PPN
JRST PPNOK ;DON'T HAVE TO PROMPT HIM
DEFPPN T3,
GETPPN T2, ;GET CURRENT PPN
; CAMN T2,T3 ;ONLY ALLOW DELETE OF CURRENT PPN
; JRST PPNOK
HRRZS T2
CAIE T2,(T3) ;LET LOSER LOSE (DELETE ON THEIR OTHER AREAS).
SETOM PDLFLG ;FLAG THAT HE HAS BEEN THROUGH HERE ONCE
JRST PPNOK
>;PDELSW
IFE PDELSW,<
SKIPN T3,DESBUF+3 ;GET PPN HE IS DELETING
DEFPPN T3,
CALLI T2,24 ;GET CURRENT PPN
CAME T3,[' 2 2'] ;ALWAYS ALLOW DELETE OF 2,2
CAMN T2,T3 ;ONLY ALLOW DELETE OF CURRENT PPN
JRST PPNOK
ERRMES(<PPN illegal for DELETE.>)
>;PDELSW
;PPNOK MAKTR1 NOIMG1 NOIMG2 CLIMAG NOTRAN GOTMEM FCLOP fclop2 FCLOP1 GOTMM1 STKPG MAKEND STKLOS
;MORE MAKTRM
PPNOK: TLNE DEVCHR,MTADEV ;THIS GUY HAS A DIRECTORY
TRNN TSWTCH,SAV ;IF THIS SWITCH IS ON
CAIA
JRST MAKTR1
TRNN TSWTCH,S
JRST MAKTR1
TLNN DEVCHR,DIRDEV ;MUST HAVE DIR TO SEARCH.
PPNOK0: JRST [ILLDEV(is not a directory device.)]
MAKTR1: TLNN DEVCHR,MTADEV ;device magtape?
TRZ T,7B28 ;no, zero special bits
TLNN PRO,BIN
TRNE T,O!DU!BLK
CAIA
JRST NOIMG1
TLNE DEVCHR,SEVIN
JRST [ILLDEV(cannot do image mode input!)]
TRNE T,DU
JRST NOIMG2
TLNN OUTCHR,SEVOUT
JRST NOIMG2
SIXOUT ODEV+1
ERRMES( cannot do image mode output!)
NOIMG1: TLNN DEVCHR,SEVIN
TLNE OUTCHR,SEVOUT
TRO T,A ;ADD /ASCII IF INPUT OR OUTPUT DEVICES NEED IT
NOIMG2:
IFN XGPSW,<
TLNN PRO,BIN ;THIS WILL OVERRIDE ASCII ASSUMPTION
TLNN OUTCHR,XGPDEV ;IF XGP, ASSUME /A UNLESS /IMAGE IS FORCED
>;XGPSW
TRO T,IMAGE ;ASSUME IMAGE MODE FOR NOW
TLNN PRO,H
TRNE T,N!DU!A!TT
TRZ T,IMAGE
LDB [POINT 6,DESBUF+5,35]
JUMPN CLIMAG
SKIPE DESBUF+6 ;page list ptr?
CLIMAG: TRZ T,IMAGE ;not image mode
IORM T,DESBUF+2 ;put it in desbuf+2 with switches
TRNE TSWTCH,S!RE!F
JRST NOTRAN ;no transfer will take place.
ANDI T,IMAGE ; "
SKIPL OMOD ; "
CAMN T,OMOD ; "
CAIA ; "
JUMPL TSWTCH,[ERRMES(Illegal modes.)]
NOTRAN: MOVEM T,OMOD ;
HRRZ T,STK
ADDI T,7
CAMG T,JOBREL ;OUT OF MEMORY?
JRST GOTMEM
CALLI T,11
JRST [NOCORE:ERRMES(Can't get core for term stack!)]
GOTMEM: HLRE T,STK
CAML T,[-8]
JUMPL STK,STKLOS
PUSH STK,DESBUF
PUSH STK,DESBUF+1
PUSH STK,DESBUF+2
PUSH STK,DESBUF+3
PUSH STK,DESBUF+4
PUSH STK,DESBUF+5
IFN XGPSW,<
MOVEI T,FCLEN*17
MOVE T2,JOBREL
FCLOP: SKIPN FCNAM(T)
JRST FCLOP1
TLNN OUTCHR,XGPDEV
JRST [ERRMES(Font select legal for XGP only!)]
CAILE T2,3(STK) ;WILL WE RUN OUT?
JRST FCLOP2
ADDI T2,1
CALLI T2,11
JRST NOCORE
MOVE T2,JOBREL
fclop2: hlre t3,stk
caml t3,[-5]
JUMPL STK,STKLOS
PUSH STK,FCNAM(T)
PUSH STK,FCEXT(T)
PUSH STK,FCPPN(T)
FCLOP1: SUBI T,FCLEN
JUMPGE T,FCLOP
PUSH STK,NULL
>;XGPSW
SKIPN T,DESBUF+6 ;GET POINTER TO PAGE LIST
JRST MAKEND ;NONE
GOTMM1: MOVE T2,JOBREL ;GET JOBREL FOR COMPARISON
STKPG: HLRE T3,STK
CAML T3,[-2]
JUMPL STK,STKLOS
PUSH STK,(T) ;PUSH A TERM
CAILE T2,(STK) ;WILL WE EXCEED MEMORY?
AOBJN T,STKPG ;INC POINTER
JUMPGE T,MAKEND ;DONE?
ADDI T2,1
CALLI T2,11
JRST NOCORE
AOBJN T,GOTMM1
MAKEND: PUSH STK,NULL ;DONE, PUSH A ZERO
SETZM SAVPGL
POPJ P,
STKLOS: ERRMES(<Sorry, ran out of term storage!>)
;DOIT NOALDL INUCK NOUENT ONEDIG STUPID SMART NOSPL
;INIT EXEC, CHECK TTY TYPE
;This section sets up each term for execution.
;The input term is in desbuf and the output term is in destin.
DOIT: TLNN TSWTCH,RUNMOD
TTYUUO 3,[ASCIZ/
/] ;put out crlf in system mode.
HRRZM STK,SAVEND ;save end of source stack.
HRRZM STK,JOBFF ;set storage after term stack
AOS JOBFF ;inc to free word
TLZ TSWTCH,FIRST!K2!K3!K4 ;set "first trans" switch., AND ALL THE "K" SWITCHES
MOVE STK,STACK ;reset to top of term stack
HRLI STK,(<POINT 36,0>) ;make into byte pointer
IFN PDELSW,<
SKIPN PDLFLG ;deleting under alias without typing it explicitly?
JRST NOALDL
SETZ T,
DEFPPN T,
OUTSTR[ASCIZ/DELETE on [/]
PPNOUT T
OUTSTR[ASCIZ/]. Type Y to go on?/]
CLRBFI
INCHRW T
CAIN T,15
INCHRS T
OUTSTR[ASCIZ/
/]
ANDI T,177 ;discard bucky-bits
CAIE T,"Y"
CAIN T,"y"
JRST NOALDL
JRST DIE
NOALDL:
>;PDELSW
IFN UDPSW,<SETZM USYNC ;SET "NO UDP YET"
TLNN OUTCHR,UDEV ;OUTPUT DEVICE UDP?
JRST INUCK ;NO
MOVE ODEV+1
PUSHJ P,INTUDP
PUSHJ P,UDPASS
JRST DIE ;DOESN'T KNOW IT
JRST NOUENT
INUCK:
SKIPN UIDEV ;ARE WE DOING INPUT FROM ANY UDP'S?
JRST NOUENT
MOVE UIDEV
PUSHJ P,INTUDP ;YES, INITIALIZE IT.
NOUENT:
>;UDPSW
MOVE T,JOBFF ;SET BUFFER LOC'S
MOVEM T,OUTFF
MOVEM T,INFF
MOVEM T,UFDFF
SETZM TOTALK ;setup file length storage.
SETZM TOTALK+1
SETZM TOTALK+2
SETZM SAVK ;PLACE TO PUT FILE SIZE DURING EXECUTION
SETZM GTOTAL ;GRAND TOTAL
SETZM GTOTAL+1
SETZM GTOTAL+2
SETZM LASTHD ;THIS REMEMBERS LAST HEADER PUT OUT!
SETOM DFTPPN ;TELL SOMEONE WE HAVEN'T PRINTED ANY YET.
IFN PASSSW,<SETZM LSTPAS> ;NO PASSWORDS DONE YET!
IFN ANDYSW,<SETZM DESTIN+6 ;SET SMART TTY FLAG.
TLNN OUTCHR,TTYDEV ;IS IT TTY?
JRST SMART ;NO
MOVE T,ODEV+1
IFE DECSW,<CALLI T,400007> ;GET PHYSICAL NAME
IFN DECSW,<CALLI T,64>
JRST 4,.+1 ;OOPS!
CAMN T,['CTY '] ;IS THIS THE CTY
JRST [ MOVSI T2,200000 ;CTYLIN
JRST STUPID ]
LDB T2,[POINT 3,T,23]
TRNN T,7700
JRST ONEDIG ;ONLY ONE DIGIT
LDB T3,[POINT 3,T,29]
LSH T2,3
ADD T2,T3
TRNN T,77 ;ANOTHER?
JRST ONEDIG
ANDI T,7
LSH T2,3
ADD T2,T
ONEDIG: TTYUUO 6,T2 ;GETLIN
TLNN T2,PTYBIT ;PTY'S ARE SMART!
STUPID: HLLOM T2,DESTIN+6 ;NO, DO THE ? CONVERSION THING
SMART: >;ANDYSW
IFN SPLSW,<
TLNN TSWTCH,LSTSWT ;ANY LISTING
HRRZS SPLBIT ;NO, CLEAR BITS!
SKIPN SPLBIT ;ANY SPOOLING TO DO?
JRST NOSPL ;NO
MOVE T,SPLDEV+1
JSR T,DEVBIT
TLNN T,DSKDEV
JRST [ILLSPL:ERRMES(The disk is not a DSK!)]
OPEN SPLCHN,SPLDEV ;GET DISK!
JRST [ERRMES(Can't get disk for SPL file!)]
CHNSTS SPLCHN,T
TRNE T,SYSDEV
JRST ILLSPL
CALLI WRD,14
LSH WRD,=24
CALLI BRK,22
MOVEM BRK,SPLNAM
ORM WRD,SPLNAM
NOSPL:
>;SPLSW
;TTYSET CHK100 NOCONF NXLIST NODIRD
;CHECK LIST OUTPUT
TLNE TSWTCH,LSTSWT ;are we listing
TLNE TSWTCH,TTYSWT ;and not special
JRST TTYSET ;no.
MOVE BRK,LSTDEV+1
JSR BRK,DEVBIT
TLNE BRK,40 ;HOPEFULLY THIS WILL TELL US
TLNN BRK,20000 ;IF THIS IS OUR CONSOLE
JRST NOCONF
TTYSET: MOVE [TTYUUO 1,BRK] ;ttyuuo's are good for you.
MOVEM ALTDEV
MOVSI 'TTY'
MOVEM LSTDEV+1 ;do this for devchr on listing device.
JRST MODOK
CHK100: PUSH P,T2
MOVEI T2,0
JBTSTS T2,
TLNN T2,10000 ;JLOG
JRST [ERRMES(Must be logged in to write files)]
POP P,T2
POPJ P,
NOCONF: PUSHJ P,CHK100 ;CHECK FOR LOGGED IN - LEGAL TO DO OPEN
MOVE T2,LSTDEV+1
JSR T2,DEVBIT
TLNN T2,LEGDEV-UDEV ;IS LIST DEVICE LEGAL
JRST ILL1
SETZ T,
IFN RETSW,<TLNE T2,DSKDEV
TRO T,200 ;recover from bad retrieval on disk.
>;RETSW
MOVEM T,LSTDEV
OPEN LST,LSTDEV ;init listing device.
JRST [ MOVE WRD,LSTDEV+1
PUSHJ P,[NODEV:RECMES(INIT failed on ,WRD,NULL,Type Y to try again.,-1)]
JRST QUIT
JRST .-1]
OUTBUF LST,2 ;two buffers
MOVE JOBFF ;fix buffer loc's
MOVEM INFF
MOVEM OUTFF
MOVEM UFDFF
SETZM SRCH+2
TLNN T2,DIRDEV ;DON'T DO ENTER FOR NON-DIR DEVICES(LET SYSTEM CATCH THEM).
JRST NODIRD
IFN PASSSW,<MOVE WRD,SRCH+3
TLNE T2,DSKDEV
JRST [ MOVE T,LSTDEV+1
PUSHJ P,PASCHK ;check password for disk and stanford only.
JRST TTYSET ;didn't know password., LIST ON TTY
JRST .+1]
>;PASSSW
MOVE T,SRCH+3
LOOKUP LST,SRCH
JRST [ MOVEM T,SRCH+3
HRRZ T,SRCH+1
JUMPE T,NXLIST
PUSHJ P,MESS22
ERRMES(Safety LOOKUP of listing file.)]
MOVEM T,SRCH+3
PUSHJ P,[RECMES(<Listing file already exists, >,LSTDEV+1,SRCH,Type Y to replace.,-1)]
JRST DIE
SETZM SRCH+2
HLLZS SRCH+1
CLOSE LST, ;AVOID GETTING INTO ALTER MODE!
NXLIST: MOVE T,SRCH+3 ;REMEMBER PPN
ENTER LST,SRCH ;output filename.
JRST [ HRRZ T,SRCH+1
PUSHJ P,MESS22
ERRMES(ENTER failed on listing file.)]
MOVEM T,SRCH+3 ;PUT PPN BACK
NODIRD: MOVE [PUSHJ P,POKE] ;where to go for buffered mode listing.
MOVEM ALTDEV
;MODOK XGPSKP XGPDON STKOVR CHKK QUIT NOSPLL NOSPLS DIE NOSPL1 NOSPL2 WOKE SPSTRT
;EXEC LOOP, QUIT, DIE, START SPOOLER
MODOK: ILDB DEVCHR,STK ;prepare first descriptor for execution.
MOVEM DEVCHR,IDEV+1 ; "
JSR DEVCHR,DEVBIT
ILDB STK ; "
MOVEM DESBUF ; "
ILDB STK ; "
HRR TSWTCH,0
HLLZM DESBUF+1
ILDB STK ; "
MOVEM DESBUF+3
ILDB PRO,STK ;GET PROTECTION AND 27 SWITCHES.
ILDB STK
MOVEM DFTLIN ;/MLENGTH= AND /EXTRA= AND /FONT=
IFN XGPSW,<
MOVEM STK,XGPPTR ;WHERE TO START FOR XGP FONTS
XGPSKP: ILDB STK
JUMPE XGPDON
ILDB STK
ILDB STK
JRST XGPSKP
XGPDON:
>;XGPSW
MOVEM STK,SAVPGL ;POINTER TO PAGE LIST WHEN INCREMENTED
ILDB STK
MOVEM GOPAGE ;INITIAL PAGE TERM
PUSH P,STK ;SAVE STACK A SECOND
JUMPE .+2
ILDB STK
JUMPN .-1
MOVE SAVEND
SKIPL TSWTCH ;IF PLUS MODE, THEN ALWAYS ASK
CAILE (STK)
TLZA TSWTCH,NOANS ;KEEP ASKING
TLO TSWTCH,NOANS ;MAY NOT HAVE TO ASK
POP P,STK ;RESTORE STK
PUSHJ P,EXSTK
STKOVR: MOVE STK,SAVPGL ;GET PAGE POINTER
ILDB STK
JUMPN .-1 ;LOOP UNTIL END (ZERO).
; RELEASE FI,0 ;release input
MOVE SAVEND ;get pointer to end of stack
CAILE (STK) ;check it
JRST [ RELEASE FI,0 ;release input
JRST MODOK ] ;not at end
TLNE TSWTCH,DELSWT ;WERE WE DELETING?
SKIPN TOTALK+1 ;YES, ANYTHING DELETED?
JRST CHKK ;NO
TLO PRO,TOT ;FORCE BLOCKS OUT
SEVSTR[ASCIZ/Total space reclaimed = /]
IFN STANSW,<
TLNN DEVCHR,DSKDEV!UDEV ;DISK OR UDP?
JRST QUIT0 ;NO
SETOM FREBIE ;SET FLAG TO OUTPUT FREE BLOCK COUNT
MTAPE FI,['GODMOD'↔22↔FREEBL] ;GET FREE BLOCK COUNT FOR THIS DEVICE
QUIT0:
>;IFN STANSW
RELEASE FI,0 ;release input
PUSHJ P,DELPRN ;USE K PRINTER
JRST QUIT ;AVOID PRINTING K AGAIN
CHKK: RELEASE FI,0 ;release input
PUSHJ P,KPRIN ;print "TOTAL=" if any
;; TLZN TSWTCH,K4 ;have we done 2 or more?
JRST QUIT ;no, that's all
MOVE GTOTAL ;put grand total in right place
MOVEM TOTALK
MOVE GTOTAL+1
MOVEM TOTALK+1
MOVE GTOTAL+2
MOVEM TOTALK+2
SEVSTR [ASCIZ/
Grand/]
PUSHJ P,KPRIN1 ;print grand total
QUIT:
IFN SPLSW,<
HLRZ T3,SPLBIT
JUMPE T3,NOSPLL
CLOSE LST,
MOVEI T2,SRCH
PUSHJ P,SPLMAK
NOSPLL: JUMPGE TSWTCH,NOSPLS ;PLUS MODE?
HRRZ T3,SPLBIT ;YES, GET BITS
JUMPE T3,NOSPLS
CLOSE FO, ;CLOSE IT SO IT WILL BE THERE
MOVEI T2,OBUF
PUSHJ P,SPLMAK
NOSPLS:
>;SPLSW
SKIPLE PGWAIT ;DO WE NEED TO WAIT BEFORE EXITING?
PUSHJ P,PGWAT1 ;YES, WAIT FOR A LF TO BE TYPED
DIE:
IFN UDPSW,<TLNE OUTCHR,UDEV
UCLOSE FO,0 >;UDPSW
RELEASE FI,0 ;end release everything
RELEASE FO,0 ; "
RELEASE MFD,0 ; "
RELEASE UFD,0 ; "
RELEASE LST,0 ; "
RELEASE CMD,0 ; "
IFN SPLSW,<
RELEASE SPLCHN,
SKIPN T,SPLBIT
JRST WOKE ;NOT SPOOLING
SETZ BRK,
TLNN T,-1
JRST NOSPL1
TLNN T,4
TROA BRK,1
TRO BRK,2
NOSPL1: TRNN T,-1
JRST NOSPL2
TRNN T,4
TROA BRK,1
TRO BRK,2
NOSPL2: MOVE WRD,['[LIST]']
TRNE BRK,1
PUSHJ P,SPSTRT
MOVE WRD,['[XSPL]']
TRNE BRK,2
PUSHJ P,SPSTRT
WOKE:
>;SPLSW
HLRZ JOBSA
MOVEM JOBFF ;end of world
CORE ;shrink
JFCL ;IGNORE LOSSAGE
TLNE TSWTCH,RUNMOD ;called by monitor?
JRST REMOD ;no, give star.
IFN HELPSW,<
TLNE TSWTCH,HLPSWT
OUTSTR[ASCIZ/
/]
>;HELPSW
CALLI 12 ;yes, that's all.
IFN SPLSW,<
SPSTRT: MOVEM WRD,MAIBUF
MAIL 5,MAIBUF ;GIVE RALPH A KICK IN THE ASS
JFCL ;BUSY IS OK
POPJ P, ;HE'S GOT IT
MOVE T,WRD ;PHANTOM NAME
MOVE T2,'SPLSYS' ;PPN
SETZ T3, ;RUN NOW
MOVEI T4,T
WAKEME T4, ;WAKE HIM UP
OUTSTR[ASCIZ/Can't start spooler!
/]
POPJ P,
>;SPLSW
;DATES KPRIN KPRIN1 DELPRN ENDK
;DATES, KPRIN
DATES: ASCIZ/Jan/ ;ascii print names for months.
ASCIZ/Feb/
ASCIZ/Mar/
ASCIZ/Apr/
ASCIZ/May/
ASCIZ/Jun/
ASCIZ/Jul/
ASCIZ/Aug/
ASCIZ/Sep/
ASCIZ/Oct/
ASCIZ/Nov/
ASCIZ/Dec/
KPRIN: TLZN TSWTCH,K2 ;TOTAL= FOR /SEARCH
POPJ P, ;NO DICE THIS TIME
KPRIN1: TLOE TSWTCH,K3 ;TELL SOMEONE THAT WE HAVE PRINTED ONE
TLO TSWTCH,K4 ;ANOTHER
popj p,; SEVSTR [ASCIZ/ Total=/]
DELPRN: MOVE T,TOTALK
ADDM T,GTOTAL ;add to grand total
PUSHJ P,KOUT ;print size
MOVE T,TOTALK+1 ;this guy has # of blocks
ADDM T,GTOTAL+1
MOVE TOTALK+2
ADDM GTOTAL+2 ;UPDATE THIS TOO
TLNN PRO,TOT ;are we really doing blocks?
JRST ENDK ;no
SEVSTR[ASCIZ/ /]
PUSHJ P,RADX10 ;print it
SEVSTR[ASCIZ/ Blk /]
MOVEI T,=100
IMUL T,TOTALK
IDIV T,TOTALK+2
PUSHJ P,RADX10
MOVEI BRK,"%"
XCT ALTDEV
IFN STANSW,<
SKIPN FREBIE ;WANT TO PRINT TOTAL FREE BLOCKS?
JRST ENDK ;NO
SETZM FREBIE ;NO MORE FREEBIES
SEVSTR[ASCIZ/ Free blocks = /]
MOVE T,FREEBL
PUSHJ P,RADX10
>;IFN STANSW
ENDK: SEVSTR[BYTE (7)15,12,12]
SETZM TOTALK
SETZM TOTALK+1
SETZM TOTALK+2
POPJ P,
;SOURCE TERM STORAGE DSCR
;This is the magical routine that gets the next term.
;and puts it in desbuf.
;It also returns withs the ascii representation of the break character
;following it in brk, right justified.
;I hope!
;the format of DESBUF is the following:
COMMENT ⊗
_________________
| |
DESBUF | device |
|_______________|
| |
DESBUF+1 | filename |
|_______________|
| |tswtch |
DESBUF+2 | ext. | (r) |
|_______|_______|
| | |
DESBUF+3 | p | pn |
|_______|_______|
|0-8 prot. |
DESBUF+4 |9-35 switches |
|__|____________|
| | |ex|
DESBUF+5 |mlength| |= |
|_______|____|__|
| pglist ptrs |
DESBUF+6 | or 0 |
|_______________|
PGLIST PTR _________________
| end | start |
| page | page |
|_______|_______|
.
.
.
_________________
| |
| 0 |
|_______________|
⊗
;TERM TERM1 DEVCHK ISDEV FILSCN ISFILN $MAIL2
;TERM: DEV, FILNAM
TERM: TLO TSWTCH,NULFLG ;set for null term
PUSHJ P,GETWRB ;get a word.
CAIA ;skip this entry point
TERM1: TLO TSWTCH,NULFLG
MOVE DFTDEV
MOVEM DESBUF
MOVE DFTPPN ;set-up default things
MOVEM DESBUF+3
MOVE PRO,DFTPRO
TRO PRO,NAMSTR!EXTSTR
MOVEM PRO,DESBUF+4
MOVE DFTLIN
MOVEM DESBUF+5
SETZM DESBUF+6 ;CLEAR PAGE LIST PTR AND CHAR MASK BITS
IFN XGPSW,<PUSHJ P,FCREST> ;RESET FONTS
HRR TSWTCH,DFTSWT ;refresh right half of switchword
HRRM TSWTCH,DESBUF+2
MOVSI '* '
HLLM DESBUF+2
MOVEM DESBUF+1
TLO TSWTCH,NOFIL ;NO FILENAME.EXT SEEN YET
JUMPN WRD,DEVCHK ;yes, jump out if preceeded by anything.
TLO TSWTCH,STICKY ;sticky switches must come here.
CAIE BRK,"(" ;PAGE LIST?
CAIN BRK,"/" ;switch?
PUSHJ P,SWITCH
TLZ TSWTCH,STICKY ;not sticky any more
JUMPE WRD,FILSCN ;GO HERE IN CASE OF FILHAK
DEVCHK: CAIN BRK,":" ;device specified?
JRST ISDEV
TLNN TSWTCH,DIRSWT ;did he say DIR
JRST FILSCN ;no
MOVE WRD
JSR DEVBIT
CAIE BRK,"/" ;these are legal for this kludge
CAIN BRK,12
TLNN DTADEV ;if it looks like a dectape we'll give it to him.
JRST FILSCN
MOVEM WRD,DESBUF
MOVEM WRD,DFTDEV
JRST NOPPN ;THIS IS ALL THAT IS LEGAL
ISDEV: JUMPE WRD,SYNERR
TLNE TSWTCH,DELSWT
SKIPN DESTIN ;have we scanned a device name already
CAIA
JRST [ERRMES(One device only!)]
MOVEM WRD,DESBUF ;save device name.
MOVEM WRD,DFTDEV ;set default device.
PUSHJ P,GETWRB ;get next word.
FILSCN: JUMPN WRD,ISFILN ;IS IT FILE NAME?
IFN FILHAK,<
CAIN BRK,"\" ;SPECIAL ESCAPE
JRST SPCFIL ;YES, CHECK FOR SPECIAL FILE HACK
CAIN BRK,"∂"
JRST BHMHAK ;BRIAN HARVEY MAIL HACK
>;FILHAK
TLNE TSWTCH,DIRSWT ;DIR?
CAIE BRK,"." ;YES, EXTENSION?
JRST GBRACK ;NO, MUST BE PPN OR SWITCHES
JRST EXTSCN ;IF DIR, THEN ".EXT" IS "*.EXT"
ISFILN: MOVEM WRD,DESBUF+1 ;must be one of these(even null).
TLZ TSWTCH,NOFIL ;SEEN FILENAME.EXT!
HRRZ DESBUF+4
TLNN TSWTCH,STRSWT ;WAS IT A STAR?
TRZ NAMSTR ;NO, CLEAR FLAG
HRRZS DESBUF+2 ;ZERO EXT SO FAR
TRZ EXTSTR
HRRM DESBUF+4
$MAIL2: CAIN BRK,"." ; . for ext.
JRST EXTSCN
MOVE DESBUF+4 ;PICK UP FLAG
TRNE NAMSTR ;NAME SPECIFIED BY STAR?
TLNN TSWTCH,DELSWT ;YES, DELETEING?
JRST GBRACK
ERRMES(You must say *. !)
;BHMHAK SPCSET SPCFIL SPCFL0 SPCFL1 HAKTAB HAKLEN HAKDSP $NEWS $DIGEST $PLAN $BBD $GRIPE $GOLD $MAIME $NAP $MAIL $MAIL0 $MAIM1 $MAI01 $MAIL1 HAK2.2 $DIG2 $FORW2 $FORW $CSD $DAY $NOTICE $MAINT $TXT $OPTION $RPG $RPG1
;SPECIAL RPH FILE HACKS
IFN FILHAK,<
BHMHAK: PUSHJ P,SPCSET
TLNE T,-1 ;ONLY 3 CHARS PLEASE
JRST [ERRMES(<Sorry, programmer name too long!>)]
TLNE TSWTCH,STRSWT ;WAS IT *?
JRST $NOTICE ;YES, DO NOTICE.TXT
JUMPE T,$MAIME ;DO ∀MAIL THING ON NO ARG
MOVEI DISP,'MSG'
JRST $MAIM1 ;EXPLICIT NAME IS OK
SPCSET: TLZ TSWTCH,NOFIL!NULFLG ;FILENAME TYPED
MOVEI NAMSTR!EXTSTR ;ASSUME NO STARS IN THIS STUFF
ANDCAM DESBUF+4
MOVEI PSTR!PNSTR ;THESE ALSO
ANDCAM DESBUF+4
ANDCAM DFTPRO+4
JRST GETWRB ;GET WORD FOLLOWING ∀ OR ∂
SPCFIL: PUSHJ P,SPCSET ;SET FLAGS AND GET NEXT IDENTIFIER
SETZB T,T4 ;T4 WILL BE POINTER TO DISPATCH FOR MATCH
MOVSI T2,770000 ;CHARACTER MASK
SPCFL0: TDNE WRD,T2 ;CHARACTER IN THIS POSITION?
TDO T,T2 ;YES, SET MASK CHAR
LSH T2,-6 ;NEXT POSITION
JUMPN T2,SPCFL0 ;DONE?
MOVSI DISP,-HAKLEN ;YES
SPCFL1: CAMN WRD,HAKTAB(DISP)
JRST @HAKDSP(DISP) ;EXACT MATCH, GO DO IT
MOVE T2,T ;GET MASK
AND T2,HAKTAB(DISP)
CAMN WRD,T2 ;PARTIAL MATCH?
JRST [JUMPN T4,[TTYUUO 1,["\"] ;YES
JRST AMBIG] ;TWO MATCHES FOUND
MOVE T4,DISP ;SAVE POINTER TO DISPATCH
JRST .+1]
AOBJN DISP,SPCFL1 ;CHECK NEXT ENTRY
JUMPN T4,@HAKDSP(T4) ;JUMP IF FOUND MATCH
SIXOUT WRD
ERRMES(<, unrecognized special file hack!>)
DEFINE HACKS
< HAKMAC BBOARD,$BBD
HAKMAC CSD,$CSD
HAKMAC DAY,$DAY
HAKMAC DOWN,$MAINT
HAKMAC DIGEST,$DIGEST
HAKMAC FORWAR,$FORW ;FORWRD.TXT[MAI,SYS]
HAKMAC G,$GRIPE ;DON'T LET \GOLD INTERFERE
HAKMAC GOLD,$GOLD
HAKMAC GRIPES,$GRIPE
HAKMAC M,$MAIL
HAKMAC MAIL,$MAIL
HAKMAC MSG,$MAIL
HAKMAC NEWS,$NEWS ;NYT NEWS SUMMARY
HAKMAC NOTICE,$NOTICE
HAKMAC NAP,$NAP
HAKMAC NS,$NAP
HAKMAC OPTION,$OPTION
HAKMAC P,$PLAN ;BECAUSE \PLAN MAKES \P, \PL AMBIGUOUS
HAKMAC PL,$PLAN ;(SHORTER FORMS MUST BE LISTED HERE FIRST)
HAKMAC PLAN,$PLAN
HAKMAC PLN,$PLAN
HAKMAC RPG,$RPG
>
DEFINE HAKMAC(A,B)
< SIXBIT/A/
>
HAKTAB: HACKS
HAKLEN←←.-HAKTAB
DEFINE HAKMAC(A,B)
< B
>
HAKDSP: HACKS
$NEWS: SKIPA DISP,['NEWS '] ;NYT news summary
$DIGEST:MOVE DISP,['DIGEST'] ;AP news digest
TLNE TSWTCH,DELSWT
JRST [ERRMES(<Sorry, don't DELETE that file!>)]
MOVEM DISP,DESBUF+1
HRRZS DESBUF+2
JRST $DIG2
$PLAN: MOVEI DISP,'PLN'
JRST $MAIL0
$BBD: SKIPA DISP,['BBOARD'] ;BBOARD.TXT[2,2]
$GRIPE: MOVE DISP,['GRIPES'] ;GRIPES.TXT[2,2]
JRST $TXT
$GOLD: TLNE TSWTCH,DELSWT
JRST [ERRMES(<Sorry, don't DELETE that file!>)]
MOVE DISP,['GRIPES'] ;GRIPES.OLD[2,2]
MOVEM DISP,DESBUF+1
MOVEI DISP,'OLD'
JRST HAK2.2
$MAIME: MOVEI DISP,'MSG'
SETZ T,
GETPPN T,
HLLI T,
SETOM WRIFLG ; TELL WHO WROTE IT TOO (if DIR command)
JRST $MAIL1
$NAP: SKIPA DISP,['NAP']
$MAIL: MOVEI DISP,'MSG'
$MAIL0: CAIE BRK,":"
JRST $MAI01
PUSHJ P,GETWRB
$MAIM1: MOVEM T,DESBUF+1
SETZ T,
GETPPN T,
HLLI T,
SETOM WRIFLG ;Tell who wrote the file if DIR command
JRST HAK2.2
$MAI01: SETZ T,
GETPPN T, ;PPN INTO T
HLLI T, ;CLEAR LEFT HALF
$MAIL1: MOVEM T,DESBUF+1 ;STORE FILENAME
HAK2.2: HRLM DISP,DESBUF+2 ;EXT
$DIG2: MOVE DISP,[' 2 2']
$FORW2: MOVEM DISP,DESBUF+3 ;PPN
MOVEM DISP,DFTPPN
JRST $MAIL2
$FORW: TLNE TSWTCH,DELSWT
JRST [ERRMES(<Sorry, don't DELETE that file!>)]
MOVE DISP,['FORWRD']
MOVEM DISP,DESBUF+1
MOVEI DISP,'TXT'
HRLM DISP,DESBUF+2
MOVE DISP,['MAISYS']
JRST $FORW2
$CSD: TLNE TSWTCH,DELSWT
JRST [ERRMES(<Sorry, don't DELETE that file!>)]
MOVE DISP,['CSD ']
MOVEM DISP,DESBUF+1
MOVEI DISP,'BBD'
HRLM DISP,DESBUF+2
MOVE DISP,['INFCSD']
JRST $FORW2
$DAY: MOVSI DISP,'DAY'
JRST $TXT
$NOTICE:SKIPA DISP,['NOTICE'] ;NOTICE.TXT[2,2]
$MAINT: MOVE DISP,['MAINT '] ;MAINT.TXT[2,2]
$TXT: TLNE TSWTCH,DELSWT
JRST [ERRMES(<Sorry, don't DELETE that file!>)]
MOVEM DISP,DESBUF+1
MOVEI DISP,'TXT'
JRST HAK2.2
$OPTION:MOVE DISP,['OPTION']
MOVEM DISP,DESBUF+1
MOVEI DISP,'TXT'
HRLM DISP,DESBUF+2
JRST $RPG1
$RPG: MOVSI DISP,'* '
MOVEM DISP,DESBUF+1 ;ALL NAMES
MOVEI DISP,'RPG'
HRLM DISP,DESBUF+2 ;ALL RPG FILES
MOVEI DISP,NAMSTR ;THESE WERE STARS
IORM DISP,DESBUF+4
$RPG1: MOVEI DISP,PSTR
IORM DISP,DESBUF+4
IORM DISP,DFTPRO ;HERE TOO
SETZ DISP,
DEFPPN DISP,
HRLI DISP,' *'
MOVEM DISP,DESBUF+3 ;ALL MY AREAS
MOVEM DISP,DFTPPN ;BETTER DO IT THE SAME EVERYWHERE
TLNN TSWTCH,DELSWT
JRST NOPPN
HLLI DISP,
SETZ WRD,
GETPPN WRD,
CAIE DISP,(WRD)
SETOM PDLFLG ;CAUSE DELETE CHECK
JRST NOPPN
>;FILHAK
;EXTSCN GBRACK PPNSCN GETPN TRYPN NOPPN NOPPN1
;TERM: EXT, PPN
EXTSCN: PUSHJ P,GETWRB
HLLM WRD,DESBUF+2
MOVE DESBUF+4
TLNE TSWTCH,STRSWT ;IS IT STAR?
TROA EXTSTR ;YES, MAKE SURE FLAG IS ON
TRZ EXTSTR ;NO, MAKE SURE FLAG IS OFF
MOVEM DESBUF+4
GBRACK: CAIE BRK,"["
JRST NOPPN
PPNSCN: MOVE T,DESBUF ;DEVICE NAME
PUSHJ P,SYSCHK ;CHECK SYSDEV
CAIA ;OK
JRST [ ERRMES(<PPN illegal with device SYS!>)]
IFN PPNSW,<PUSHJ P,GETWRB ;get p.
MOVE WRD,T ;get right justified version>
IFE PPNSW,<PUSHJ P,SOCTIN
CAILE WRD,-1
JRST ILLPPN >;PPNSW
HRLM WRD,DESBUF+3 ;to mem.
MOVEI DISP,PSTR!PNSTR
ANDCAM DISP,DESBUF+4
ANDCAM DISP,DFTPRO
TLNN TSWTCH,STRSWT
TRZ DISP,PSTR
TRNN WRD,-1
JRST [ILLPPN:ERRMES(<Illegal PPN>)]
CAIE BRK,","
CAIN BRK,"."
JRST GETPN
HRRZ WRD,DFTPPN ;maybe this will be [p]
JUMPN WRD,TRYPN
DEFPPN WRD, ;have to ask system about current default
HLLI WRD,
JRST TRYPN
GETPN:
IFN PPNSW,<PUSHJ P,GETWRB ;get pn.
MOVE WRD,T>
IFE PPNSW,<PUSHJ P,SOCTIN
CAILE WRD,-1
JRST ILLPPN >;PPNSW
TLNN TSWTCH,STRSWT
TRYPN: TRZA DISP,PNSTR ;NO PN=* FOR SURE
TLNN TSWTCH,DELSWT ;PN=*, ARE WE DOING A DELETE COMMAND?
JRST TRYPN0 ;NO
ERRMES(<"*" not permitted as programmer name in DELETE command!>)
TRYPN0: IORM DISP,DESBUF+4
IORM DISP,DFTPRO
TRNN WRD,-1
JRST ILLPPN
HRRM WRD,DESBUF+3 ;to mem.
SETZ T,
DEFPPN T,
CAMN T,DESBUF+3 ;same as for this term?
SETZM DESBUF+3 ;yes set to zero.
MOVE DESBUF+3 ;get PPN.
MOVEM DFTPPN ;set as default option.
SETZ WRD,
CAIN BRK,"]" ;RIGHT BRACKET IS OPTIONAL
PUSHJ P,GETWRD ;get next word.
JUMPE WRD,NOPPN1
WRDMES(<Illegal after PPN.>)
NOPPN: MOVE T,DESBUF
MOVE T2,[' 1 3']
PUSHJ P,SYSCHK ;CHECK DEV SYS
CAIA
MOVEM T2,DESBUF+3 ;STORE SYS PPN
NOPPN1: CAIE BRK,"("
CAIN BRK,"/"
PUSHJ P,SWITCH
CAIE BRK,"@"
POPJ P,
;INDIR
;INDIRECT
INDIR: MOVE DFTDEV
MOVEM SAVDEV
MOVE DFTPPN
MOVEM SAVPPN
MOVE DFTLIN
MOVEM SAVLIN
HRR TSWTCH,DFTSWT
MOVEM TSWTCH,SAVSWT
MOVE PRO,DFTPRO
MOVEM PRO,SAVPRO
SKIPN DESBUF+6 ;NO PAGE LIST IN @ TERM
TLNN TSWTCH,NOFIL ;must be no filename yet!
JRST SYNERR
PUSH P,DFTDEV
PUSH P,DFTPPN
PUSHJ P,TERM ;scan indirect term.
POP P,DFTPPN
POP P,DFTDEV
MOVEM BRK,SAVCHR ;save break char.
MOVE [TYI] ;allow indirect as last file of indirect
CAME CMDGET ;are we already indirecting?
JRST [ERRMES(Command file cannot use indirection except in last term.)]
SKIPE DESBUF+6
JRST SYNERR
HRR TSWTCH,DESBUF+2
MOVEM TSWTCH,DFTSWT
MOVE PRO,DESBUF+4
MOVEM PRO,DFTPRO
MOVE DESBUF+5
MOVEM DFTLIN
MOVE T3,DESBUF ;device
JSR T3,DEVBIT
TLNN T3,LEGDEV ;legal device?
JRST ILL1
TLNN T3,DIRDEV ;directory?
JRST CMDOPN ;no, go ahead.
HRRZ T,DESBUF+4
TRNE T,NAMSTR!EXTSTR!PSTR!PNSTR
JRST [ILLCMD:ERRMES("*" illegal for command file.)]
;STKMAX CMDOPN CMDOP1 CMDOP2 CMDOP3 CMDOP4
STKMAX←←=10000 ;Now we can handle lots of files, I hope
;INDIRECT
CMDOPN: MOVE DESBUF ;ok, lets do it.
MOVEM CMDDEV+1
MOVE DESBUF+1 ;make a lookup block.
MOVEM DESBUF
MOVE DESBUF+2
MOVEM DESBUF+1
MOVEI STKMAX*7+2(STK) ;leave enough room for 100 more terms
MOVEM JOBFF
HRLI STK,-STKMAX*7 ;make pdl ov happen
IFN RETSW,<
MOVEI 0
TLNE T3,DSKDEV
TRO 200 ;STANFORD HAS BAD RETRIEVAL RECOVERY!
MOVEM CMDDEV >;RETSW
IFE RETSW,<SETZM CMDDEV> ;for dec(dummies!)
IFN UDPSW,<SETZM USYNC
TLNN T3,UDEV
JRST CMDOP1
MOVE CMDDEV+1 ;SETUP DEVICE NAME FOR INTUDP
PUSHJ P,INTUDP
UOPEN CMD,CMDDEV
>;UDPSW
CMDOP1: OPEN CMD,CMDDEV ;open it.
JRST [ERRMES(Cannot INIT command device.)]
IFN UDPSW,<TLNN T3,UDEV>
INBUF CMD,1 ;one buffer.
MOVE WRD,DESBUF+3 ;SAVE PPN
HLLZS DESBUF+1
IFN UDPSW,<TLNE T3,UDEV
ULOOK CMD,DESBUF >;UDPSW
LOOKUP CMD,DESBUF ;lookup file.
JRST CMDOP3
CMDOP2: MOVE [PUSHJ P,CMDCHR]
MOVEM CMDGET ;get input from command file now.
MOVEI BRK,","
MOVEM BRK,C.LAST
JRST TERM
CMDOP3: MOVEM WRD,DESBUF+3 ;PUT BACK PPN
HLRZ WRD,DESBUF+1
JUMPN WRD,CMDOP4
MOVSI WRD,'CMD'
MOVEM WRD,DESBUF+1
IFN UDPSW,<TLNE T3,UDEV
ULOOK CMD,DESBUF >;UDPSW
LOOKUP CMD,DESBUF ;TRY .CMD
CAIA
JRST CMDOP2
HRRZS DESBUF+1 ;PUT EXTENSION BACK LIKE WE FOUND IT
CMDOP4: HRRZ T,DESBUF+1
PUSHJ P,MESS22
PUSHJ P,[RECMES(,CMDDEV+1,DESBUF,<Type Y to go on without it.>,-1)]
JRST QUIT
JRST TERM ;TRY TO GO ON WITHOUT THIS INDIRECT FILE
;SWITCH SW2 MASKMAK MASKIT AMBIG
;SWITCH
;This guy reads a variable length switch, decides if it is sticky or not
;and turns on the corresponding bits in tswtch and dftswt.
;dftswt is altered only if the STICKY bit is on in the left half of tswtch.
SWITCH: HRR TSWTCH,DESBUF+2 ;get sticky switches for comparison.
MOVE PRO,DESBUF+4 ;and dftpro
MOVE DISP,DESBUF+5
CAIE BRK,"/"
JRST PGLIST
SW2: PUSHJ P,GETWRD ;get switch.
SETZB T,ALT ;zero t and t4.
HRLZI T2,770000 ;make a sixbit char. mask.
TDNN WRD,T2 ;test wrd.
JRST SYNERR
TLNN TSWTCH,DIRSWT ;for DIR
JRST MASKMAK
CAME WRD,['L ']
JRST MASKMAK
TLZ TSWTCH,TTYSWT ;/L makes you use what is in lstdev+1 as the output device.
JRST SWEND
MASKMAK:TDO T,T2 ;extend mask to chars. tested so far.
LSH T2,-6 ;move test mask to right one char.
TDNE WRD,T2 ;test for char.
JUMPN T2,MASKMAK ;if still in word go extend mask.
MOVEI T2,SWTLST ;point to switch list.
MASKIT: MOVE T3,T ;get mask.
AND T3,(T2) ;get proper number of letters from switch.
CAMN WRD,(T2)
JRST SWTTAB-SWTLST(T2) ;EXACT MATCH
CAMN WRD,T3 ;compare with switch typed in.
JRST [ JUMPN ALT,[TTYUUO 1,["/"] ;yse, error.
AMBIG:PUSHJ P,SIXOU1 ;tell him.
ERRMES( is ambiguous.)]
MOVE ALT,T2 ;put pointer to switch in t4.
JRST .+1] ;back to main stream.
CAIGE T2,ENDLST-1 ;end of switch list?
AOJA T2,MASKIT ;no, inc. pointer and go back.
SKIPN ALT ;switch found?
JRST [WRDMES( Unknown switch.)]
JRST SWTTAB-SWTLST(ALT) ;use switch list pointer to get to proper routine.
;SWTTAB MEND
;DUMPED, QUIET, LIST, PROTECTION=, NONUMBERS, DENSITY=
;THESE ARE THE SWITCH ROUTINES ONE PER CUSTOMER!
SWTTAB:
JRST [ ;/DUMPED
IFN STANSW,< TRNE TSWTCH,S
JRST [ SETOM DMPFLG
JRST SWEND]
TRNE TSWTCH,O!BLK!RE!A
>;END STANSW
IFE STANSW,< TRNE TSWTCH,O!BLK!RE!A!S >
JRST [ILLCOM:ERRMES(Illegal switch combination.)]
MOVEI T,DU
JRST TURNON]
JRST [ MOVEI T,Q ;/quiet
JRST TURNON]
JRST [ TLO TSWTCH,LSTSWT ;/list
MOVEI T,L
JRST TURNON]
JRST [ TRNE TSWTCH,S ;/protection
JRST [ SETOM PROFLG ;print protection with directory
SETOM UPRFLG ;Give him UFD protection as bonus
JRST SWEND]
PUSHJ P,GETWRC ;MAKE SURE WE SEE BREAK
CAIE BRK,"="
JRST [ERRMES(<"PROTECTION" must be followed by "=".>)]
PUSHJ P,OCTIN
CAILE WRD,777
JRST [ERRMES(Illegal protection.)]
DPB WRD,[POINT 9,PRO,8]
TLNE TSWTCH,STICKY
DPB WRD,[POINT 9,DFTPRO,8]
MOVSI T,PP
JRST PTURNON]
JFCL ;/N
JRST [ TLNN PRO,BIN
TRNE TSWTCH,O!S!RE!BLK!DU ;/nonumbers
JRST ILLCOM
MOVEI T,N!A ;FORCE /ASCII
JRST TURNON]
JRST [ PUSHJ P,GETWRC ;/DENSITY. MAKE SURE WE SEE BREAK
CAIE BRK,"="
JRST [ERRMES(<"DENSITY" must be followed by "=".>)]
PUSHJ P,GETWRD
CAMN WRD,['800 ']
JRST [ MOVEI T,D800
JRST MEND]
CAMN WRD,['556 ']
JRST [ MOVEI T,D556
JRST MEND]
CAMN WRD,['200 ']
JRST [ MOVEI T,D200
JRST MEND]
ERRMES(Illegal density.)
MEND: MOVEI T2,D800
TLNE TSWTCH,STICKY
ANDCAM T2,DFTSWT
TLNE TSWTCH,STICKY
IORM T,DFTSWT
ANDCMI TSWTCH,D800
IORM T,TSWTCH
JRST SWEND]
;EVEN, ODD, BLOCK, BINARY, LENGTH=, ASCII, SEARCH, SRCSWT, FRCASC
JRST [ MOVEI T,EVEN ;/even
JRST TURNON]
JRST [ TRZ TSWTCH,EVEN ;odd parity switch
MOVEI T,EVEN
TLNE TSWTCH,STICKY
ANDCAM T,DFTSWT
JRST SWEND]
JRST [ TLNN PRO,H
TRNE TSWTCH,A!TT!O!FRT!S!RE!DU!N!SAV;blocked transfer
JRST ILLCOM
SKIPN DESBUF+6
TRNE DISP,77
JRST ILLCOM
TLO PRO,BIN
MOVSI T,BIN
TLNE TSWTCH,STICKY
IORM T,DFTPRO
MOVEI T,BLK
JRST TURNON]
JFCL ;SEE NEXT COMMENT
JRST [ TRNN TSWTCH,O!A!TT!FRT!S!RE!DU!N ;/BINARY
TLNE PRO,H
JRST ILLCOM
SKIPN DESBUF+6
TRNE DISP,77
JRST ILLCOM
MOVSI T,BIN
JRST PTURNON]
JRST [ PUSHJ P,GETWRC ;MAKE SURE WE SEE BREAK
CAIE BRK,"=" ;variable length mta records.
JRST [ERRMES(<"LENGTH" must be followed by "=".>)]
PUSHJ P,OCTIN
CAILE WRD,3
CAILE WRD,10000 ;Arbitrary max, 6 bufs this size, see PHONY
JRST [ERRMES(Illegal length.)]
AOJ WRD,
HRLM WRD,DISP
TLNE TSWTCH,STICKY
HRLM WRD,DFTLIN
JRST SWEND]
JFCL ;/ASCII
JRST [FRCASC:TLNN PRO,BIN
TRNE TSWTCH,O!S!RE!BLK ;/ascii
JRST ILLCOM
MOVEI T,A
JRST TURNON]
JRST [SRCSWT:TRNN TSWTCH,O!N!DU!BLK!A!RE!FRT!TT ;/SEARCH
TLNE PRO,PP!H!BIN
JRST ILLCOM
SKIPN DESBUF+6
TRNE DISP,77
JRST ILLCOM
TLO TSWTCH,LSTSWT
MOVEI T,S!L
JRST TURNON]
;FOOFST
;RENAME, FAST, KILL, OPTIMIZE, TITLE, SAVE, HEADER, CONVERT
JRST [ TLNN PRO,H!BIN!TOT
TRNE TSWTCH,O!DU!N!BLK!S!A!FRT!TT!SAV ;/rename
JRST ILLCOM
SKIPN DESBUF+6
TRNE DISP,77
JRST ILLCOM
MOVEI T,RE
JRST TURNON]
JFCL ;/F
JRST [
FOOFST: TLNN PRO,PP!H!BIN ;/FAST
TRNE TSWTCH,O!N!DU!BLK!A!RE!FRT!TT
JRST ILLCOM
SKIPN DESBUF+6
TRNE DISP,77
JRST ILLCOM
TLO TSWTCH,LSTSWT
MOVEI T,F!S!L
JRST TURNON]
JRST [ MOVEI T,0 ;/KILL ILLEGAL W/O LOGIN
JBTSTS T,
TLNE T,10000 ;THIS IS JLOG
TRNE TSWTCH,S!RE ;/kill
JRST ILLCOM
MOVEI T,K
JRST TURNON]
JRST [ TRNN TSWTCH,N!FRT!TT!DU!A!RE!S!BLK ;/optimize
TLNE PRO,H!BIN
JRST ILLCOM
SKIPN DESBUF+6
TRNE DISP,77
JRST ILLCOM
MOVEI T,O
JRST TURNON]
JRST [ TRNN TSWTCH,O!RE!S!BLK ;/TITLE
TLNE PRO,BIN
JRST ILLCOM
MOVEI T,TT
JRST TURNON]
JRST [ TRNE TSWTCH,RE ;/SAVE
JRST ILLCOM
MOVEI T,SAV
JRST TURNON]
JRST [ TLNN PRO,BIN
TRNE TSWTCH,O!S!BLK!RE
JRST ILLCOM
MOVSI T,H ;/HEADER
JRST PTURNON]
JRST [ TLNN PRO,BIN
TRNE TSWTCH,O!S!BLK!DU!RE
JRST ILLCOM
MOVEI T,FRT!A ;/CONVERT
JRST TURNON]
;ISPCX SETASC FONT0S NFCEXT FONTDN FONTDM
;EXTRA, GTOTAL, IGNI, IGNO, ASK, FULL, SPOOL, DSPOOL, FONT
JRST [ TLNN PRO,BIN
TRNE TSWTCH,O!DU!S!BLK!RE ;/EXTRA
JRST ILLCOM
PUSHJ P,GETWRC ;MAKE SURE WE SEE BRREAK
IFN XGPSW,< CAIN BRK,"≡"
JRST [ HRROS (P)
PUSHJ P,DECIN
SETOM XGPSWT ;FLAG XGP SWITCH SEEN
JRST ISPCX]
HRRZS (P)
>;XGPSW
CAIE BRK,"="
JRST [ERRMES("EXTRA" must be followed by "=".)]
PUSHJ P,DECIN
CAILE WRD,=53
JRST [ERRMES(Too many extra line feeds.)]
TRNN WRD,77
TRO WRD,77
ISPCX: DPB WRD,[POINT 6,DISP,35]
TLNE TSWTCH,STICKY
DPB DISP,[POINT 6,DFTLIN,35]
IFN XGPSW,< SKIPL (P) ;SETTING INTERLINE SPACING?
JRST SETASC ;NO, JUST SET ASCII
MOVEI T,ISPACE ;INDICATE INTERLINE SPACING
TDO PRO,T
TLNE TSWTCH,STICKY
IORM T,DFTPRO
SETASC:
>;XGPSW
MOVEI T,A ;FORCE ASCII SO IT WILL HAPPEN
JRST TURNON]
JRST [ MOVSI T,TOT ;/GTOTAL
TDO PRO,T
TLNE TSWTCH,STICKY
IORM T,DFTPRO
JRST SRCSWT]
JRST [ MOVSI T,IGNO ;/IGNO
JRST PTURNON]
JRST [ MOVSI T,IGNI ;/IGNI
JRST PTURNON]
JRST [ MOVSI T,ASK ;/ASK
JRST PTURNON]
JRST [ ;/FULL
IFN STANSW,< SETOM DMPFLG ;GIVE HIM THE WORKS
SETOM REFFLG
SETOM WRIFLG
>;STANSW
SETOM UPRFLG
SETOM TIMFLG
SETOM PROFLG
SETOM FULFLG
JRST SWEND]
IFN SPLSW,<
JRST [ MOVEI T,SPLSWT ;/SPOOL
JRST PTURNON]
JRST [ MOVEI T,SPDSWT ;/DSPOOL
JRST PTURNON]
>;SPLSW
IFN XGPSW,<
JRST [ TRNE TSWTCH,O!S!RE!BLK ;/FONT=
JRST ILLCOM
SETOM XGPSWT ;FLAG XGP SWITCH SEEN
PUSHJ P,GETWRC ;MAKE SURE WE SEE BREAK
SETZ WRD,
CAIE BRK,"#" ;ANY FONT #?
JRST FONT0S ;IF NO FONT #, ASSUME 0
PUSHJ P,DECIN
CAILE WRD,FCNMAX
JRST [ ERRMES(<Sorry, font number too large!>)]
IMULI WRD,FCLEN
PUSHJ P,GETWRC ;GET BREAK
FONT0S: CAIE BRK,"="
JRST [ ERRMES(<Sorry, font # must be followed by =fontname!>)]
PUSH P,DISP
MOVE DISP,WRD
SETZM FCPPN(DISP)
MOVSI WRD, ;USED TO BE 'FNT'
HLLM WRD,FCEXT(DISP)
PUSHJ P,GETWRD
JUMPE WRD,[ILLFNT:ERRMES(Illegal font name!)]
MOVEM WRD,FCNAM(DISP)
CAIE BRK,"."
JRST NFCEXT
PUSHJ P,GETWRD
HLLM WRD,FCEXT(DISP)
NFCEXT: CAIE BRK,"["
JRST FONTDN
PUSHJ P,GETWRB
HRRZ T,T
JUMPE T,ILLFNT
HRLM T,FCPPN(DISP)
CAIE BRK,","
JRST ILLFNT ;PROGRAMMER NAME REQUIRED FOR FONTS
PUSHJ P,GETWRB
HRRZ T,T
JUMPE T,ILLFNT
HRRM T,FCPPN(DISP)
CAIN BRK,"]" ;RIGHT BRACKET IS OPTIONAL
MOVEI BRK," "
FONTDN: TLNN TSWTCH,STICKY
JRST FONTDM
MOVE WRD,FCNAM(DISP)
MOVEM WRD,FCNAM+FCPERM(DISP)
MOVE WRD,FCEXT(DISP)
MOVEM WRD,FCEXT+FCPERM(DISP)
MOVE WRD,FCPPN(DISP)
MOVEM WRD,FCPPN+FCPERM(DISP)
FONTDM: POP P,DISP
JRST SWEND]
>;XGPSW
;WAIT ALL FOO REFERENCE NOSPACES WRITER OFFSET TIME NOFF UFDPRO PAUSE UIGNORE ACCESS OONLY BONLY
IFN DEVWAIT,<
JRST [ MOVEI T,DWAIT ;/WAIT
JRST PTURNON]
>;DEVWAIT
IFN STANSW,<
JRST [ MOVSI T,ALL ;/ALL
JRST PTURNON]
>;STANSW
IFN FOOSW,<
JRST [ MOVEI T,FOOSWT ;/FOO
TLNE TSWTCH,STICKY
IORM T,DFTPRO
TRO PRO,FOOSWT
JRST FOOFST]
>;FOOSW
IFN STANSW,<
JRST [ SETOM REFFLG ;/REFERENCE
JRST SRCSWT]
>;STANSW
JRST [ TLNN PRO,BIN
TRNE TSWTCH,O!S!BLK!DU!RE
JRST ILLCOM
MOVEI T,XSPACE ;/NOSPACES
TLNE TSWTCH,STICKY
IORM T,DFTPRO
TRO PRO,XSPACE
MOVEI T,A ;FORCE /A
JRST TURNON]
IFN STANSW,<
JRST [ SETOM WRIFLG ;/WRITER
JRST SRCSWT]
JRST [ SETOM OFFFLG ;/OFFSET
JRST SRCSWT]
>;STANSW
JRST [ SETOM TIMFLG ;/TIME
JRST SRCSWT]
JRST [ MOVEI T,NOF ;/NOFF
TRO PRO,NOF ;turn on bit in pro
TLNE TSWTCH,STICKY ;is it sticky
IORM T,DFTPRO ;yes, dftpro also
JRST FRCASC] ;now force /ASCII so it will work
JRST [ SETOM UPRFLG ;/UFDPRO
JRST SRCSWT]
JRST [ TLNN PRO,BIN ;/PAUSE
TRNE TSWTCH,O!S!BLK!DU!RE
JRST ILLCOM
SETOM PGWAIT
JRST SWEND]
JRST [ SETOM UIGFLG ;/UIGNORE
JRST SWEND]
IFN STANSW,<
JRST [ PUSH P,T ;/ACCESS
MOVSI T,REAPRV!WRTPRV!PROPRV
SETPRV T,
POP P,T
JRST SWEND]
JRST [ SETOM OFFNLY ;/OONLY (ONLY FILES WITH OFFSET)
SETOM OFFFLG
JRST SRCSWT]
JRST [ SETOM BIGNLY ;/BONLY (ONLY BIG FILES)
PUSHJ P,GETWRC ;MAKE SURE WE SEE BREAK
CAIE BRK,"=" ;Is an explicit size coming?
SKIPA WRD,[=256] ;No, use default size threshold (in K)
PUSHJ P,DECIN ;Read decimal size (in K)
LSH WRD,=10 ;Convert size to words
MOVEM WRD,BTHRES ;Store threshold for listing big files
JRST SRCSWT]
>;STANSW
;This is where you add switches.
;PTURNON TURNON SWEND SWTLST
;TURNON, PTURNON, SWEND, SWTLST
PTURNON:TDO PRO,T ;turn on bit in pro
TLNE TSWTCH,STICKY ;is it sticky
IORM T,DFTPRO ;yes, dftpro also
JRST SWEND
TURNON: TDO TSWTCH,T ;turn on bit in tswtch
TLNE TSWTCH,STICKY ;sticky?
IORM T,DFTSWT ;yes
SWEND: SETZM WRD ;
CAIN BRK," " ;switch followed by space?
PUSHJ P,GETWRB ;yes, get next word.
CAIN BRK,"/" ;do we now break on a switch?
JUMPE WRD,SW2 ;yes, jump if nothing before switch.
HRRM TSWTCH,DESBUF+2 ;store switch.
MOVEM PRO,DESBUF+4 ;store updated pro
MOVEM DISP,DESBUF+5 ;and disp
CAIN BRK,"(" ;page list?
JUMPE WRD,PGLIST
POPJ P, ;no back to mother
SWTLST: 'DUMPED' ;octal output of 36 bit words.
'QUIET ' ;shut up!
'LIST ' ;give me a list of files transferred.
'PROTEC' ;set protection.
'N ' ;NEXT COMMENT
'NONUMB' ;delete sequence numbers.
'DENSIT' ;set magtape density.
'EVEN ' ;set even parity.
'ODD ' ;set even parity.
'BLOCKE' ;do blocked transfers.
'B ' ;NEXT COMMENT
'BINARY' ;/BINARY FORCE WORD BY WORD TRANSFER
'MLENGT' ;set variable length magtape records.
'A ' ;NEXT COMMENT
'ASCII ' ;set for ascii transfer.
'SEARCH' ;do search only.
'RENAME' ;rename file(allow protection change).
'F ' ;SAME
'FAST ' ;no lookup search.
'KILL ' ;delete input file.
'OPTIMI' ;force optimization.
'TITLE ' ;title page.
'SAVE ' ;SAVE 4 WORDS OF DIRECTORY
'HEADER' ;MAKE LISTER TYPE HEADER
'CONVER' ;FORTRAN CARRAIGE CONTROL
'EXTRA ' ;EXTRA LINE FEEDS.
'GTOTAL' ;DUMP "TOTAL=" AT END OF EACH TERM
'IGNO ' ;IGNORE OUTPUT ERRORS.
'IGNI ' ;IGNORE INPUT ERRORS.
'ASK ' ;ASK BEFORE EACH TRANSFER
'FULL ' ;FULL DIRECTORY TYPEOUT
IFN SPLSW,<
'SPOOL ' ;SPOOL OUTPUT
'DSPOOL' ;SPOOL OUTPUT /D
>;SPLSW
IFN XGPSW,<
'FONT ' ;SET FONT FILENAME
>;XGPSW
IFN DEVWAIT,<
'WAIT ' ;WAIT FOR DEVICE AVAILABLE
>;DEVWAIT
IFN STANSW,<
'ALL ' ;ALL OF THIS FILE (EVEN "HIDDEN" RECORDS)
>;STANSW
IFN FOOSW,<
'FOO ' ;SPECIAL FOO DIRECTORY SWITCH
>;FOOSW
IFN STANSW,<
'REFERE' ;PRINT REFERENCE DATE IN DIRECTORY LISTING
>;STANSW
'NOSPAC' ;DELETE TRAILING SPACES
IFN STANSW,<
'WRITER' ;LIST AUTHOR OF FILE FROM RETRIEVAL
'OFFSET' ;INCLUDE RECORD OFFSET IN DIRECTORY LISTING
>;STANSW
'TIME ' ;INCLUDE TIME WRITTEN IN DIRECTORY LISTING
'NOFF ' ;SUPPRESS FormFeeds FROM OUTPUT FILE
'UFDPRO' ;TYPE OUT UFD PRO AND DEF PRO IN DIR LISTING
'PAUSE ' ;PAUSE BETWEEN ELEMENTS OF PAGE LIST IN TYPEOUT
'UIGNOR' ;IGNORE UFDS PROTECTED FROM US
IFN STANSW,<
'ACCESS' ;ACCESS PROTECTED FILES
'OONLY ' ;ONLY LIST FILES THAT HAVE AN OFFSET
'BONLY ' ;ONLY LIST FILES THAT ARE BIGGER THAN BTHRES
>;STANSW
ENDLST←←.
;PGLIST PGINC PGLOOP PGLP1
;PAGE LIST
;THIS SCANS A PAGE LIST AND SETS UP A STACK FOR THE TERMS
;AND PUTS A POINTER IN RIGHT HALF OF DESBUF+6
PGLIST: TLNN PRO,BIN
TRNE TSWTCH,BLK!S!RE ;illegal with /SEARCH or /BLOCKED
JRST ILLCOM
SKIPE T,DESBUF+6 ;first time this term?
JRST [ HLRZ T ;no, extend
MOVNS ;positive number of terms
PGINC: AOBJN T,PGINC ;advance t to last term of page list so far
SOJ T, ;backup one
HRLM T ;set count in left half
JRST PGLOOP] ;go on
SKIPN T,SAVPGL ;this arranges to avoid stepping on existing page list
MOVEI T,LPTHD-1 ;no start from the top
MOVEM T,DESBUF+6 ;save starting loc.
AOS DESBUF+6 ;inc
PGLOOP: HLRZ T ;get num of terms so far
CAIL 20 ;no more than 15
JRST [ILLPG:ERRMES(Illegal page or word spec.)]
PUSHJ P,DECIN ;read starting page
CAILE WRD,777777
JRST ILLPG
JUMPL WRD,ILLPG
PUSH T,WRD ;save in page list storage
CAIE BRK,":" ;is there an ending page?
JRST PGLP1
PUSH P,T
PUSHJ P,SDECIN ;yes get it
POP P,T
TLNE TSWTCH,STRSWT
MOVEI WRD,777777 ;GET MAX NUMBER
JUMPLE WRD,ILLPG
CAIG WRD,777777
CAMGE WRD,(T) ;MUST BE BIGGER OR EQUAL!
JRST ILLPG
PGLP1: HRLM WRD,(T) ;use which ever is here
SKIPN (T) ;can't have 0,,0 or will look like end
JRST ILLPG
CAIN BRK,"," ;more?
JRST PGLOOP ;yes
HRRZM T,SAVPGL ;no, remember where last term is stored
HLRZS T ;get count
MOVNS T ;make it negative
HRLM T,DESBUF+6 ;save in term storage
CAIN BRK,12 ;NO PAREN NEEDED AT END OF LINE
POPJ P,
CAIE BRK,")" ;legal end?
JRST ILLPG
PUSHJ P,GETWRB ;scan on
CAIN BRK,"(" ;another page list?
JUMPE WRD,PGLIST ;yes stupid user
CAIN BRK,"/"
JUMPE WRD,SW2
POPJ P,
;MESMAK GOTSND SNDMRG
;SEND
;this sets up the all encompassing message maker!
;It extends the message if it already exists.
IFN SENDSW,<
MESMAK: SETZM MESFLG
CAIN BRK,12 ;end of line?
JRST [ERRMES(Send who?)];yep!
CAIE BRK,40 ;better be a space
JRST [CHRMS4:CHRMES(Illegal after SEND.)];nope.
MOVSI T,'MSG' ;DEFAULT EXT
MOVEM T,MESEXT
PUSHJ P,GETWRB ;get programmer.
TLNE T,-1
JRST [TOLONG:WRDMES(<, is too long for "SEND".>)]
JUMPE T,SYNERR ;none found
CAIN BRK,12 ;SHORT SEND *,PN?
JRST GOTSND ;YES
CAIE BRK,","
JRST CHRMS4
TLNE TSWTCH,STRSWT ;*?
SETZ T, ;YES
PUSH P,T
PUSHJ P,GETWRB
TLNE T,-1
JRST TOLONG
CAIE BRK,12
JRST CHRMS4
JUMPE T,SYNERR
POP P,WRD
HRL T,WRD
GOTSND: TLNE TSWTCH,STRSWT
TRZ T,-1
JUMPN T,SNDMRG
MOVSI T,'TXT'
MOVEM T,MESEXT
MOVE T,['NOTICE']
SETOM MESFLG ;FLAG FOR ∂ THING
SNDMRG: MOVEM T,DESTIN+1 ;destination
MOVEM T,DESBUF+1 ;source
MOVEM T,SOURCE ;to see if it is already there.
TRNN T,-1 ;send proj?
SETOM MESFLG ;YES, FLAG IT
MOVE MESEXT
HRRI A!Q!N
MOVEM DESTIN+2 ;destination
MOVEM DESBUF+2 ;source
MOVEM SOURCE+1
MOVE [' 2 2'] ;everything is on 2,2
MOVEM DESTIN+3
MOVEM DESBUF+3
MOVEM SOURCE+3
SETZM DESTIN+4
SETZM DESTIN+5
SETZM DESTIN+6
SETZM DESBUF+4
SETZM DESBUF+5
SETZM DESBUF+6
CAIE BRK,12 ;better be end
JRST CHRMS4
MOVSI 'DSK'
MOVEM DESTIN
MOVEM IDEV+1
SETZM SOURCE+2
PUSHJ P,DESTRM ;make a destination term
MOVEI T,200
MOVEM T,IDEV ;recover from bad ret.
OPEN FI,IDEV
JRST [ERRMES(Where's the disk?)]
MOVSI 'TTY' ;now from tty.
MOVEM DESBUF
PUSHJ P,MAKTRM ;yes, extend it.
MOVSI T,'DSK'
MOVEM T,DESBUF
PUSHJ P,SYSCHK
CAIA
JRST [ERRMES(<Not to device SYS!>)]
LOOKUP FI,SOURCE ;does file exist
JRST [ HRRZ T,SOURCE+1
JUMPE T,.+2
PUSHJ P,MESS22
ERRMES(You lose.)]
PUSHJ P,MAKTRM ;make source term
JRST DOIT
>;SENDSW
;HELPER
;HELP
;THIS TRIES TO HELP THE USER BY GETTING THE FILE <name>
;FROM [3,2] AND LISTING IT ON THE TTY.
;NO ARGUMENT CAUSES DIR/F[3,2] TO HAPPEN.
IFN HELPSW,<HLPCOM:CAIN BRK,12 ;HELP only
JRST HELPER ;yes do dir
PUSHJ P,GETWRB ;get arg
TLNN TSWTCH,STRSWT ;*?
CAIE BRK,12 ;or somethingstupid
JRST HELPER ;do the bombay door thing.
JUMPE WRD,HELPER ;stupid
MOVEM WRD,DESBUF+1 ;whew!
MOVSI 'DSK' ;disk obviously
MOVEM DESBUF
MOVEI N ;no line numbers
MOVEM DESBUF+2 ;and no ext.
MOVE [' 3 2'] ;help ufd
MOVEM DESBUF+3
SETZM DESBUF+4
SETZM DESBUF+5
SETZM DESBUF+6
MOVSI 'TTY'
MOVEM DESTIN
SETZM DESTIN+1
MOVE [XWD DESTIN+1,DESTIN+2]
BLT DESTIN+6
PUSHJ P,DESTRM ;tty out
PUSHJ P,MAKTRM ;file in
JRST DOIT ;go you mother
HELPER: TTYUUO 11, ;clear out the rest of the garbage.
PUSHJ P,DFTTRM ;no output
MOVSI 'DSK'
MOVEM DESBUF
MOVSI '* '
MOVEM DESBUF+1 ;just extensionless ones
MOVEI S!L!F ;dir bits
MOVEM DESBUF+2
MOVE [' 3 2'] ;help ufd
MOVEM DESBUF+3
MOVEI NAMSTR
MOVEM DESBUF+4 ;* FILENAMES
SETZM DESBUF+5
SETZM DESBUF+6
PUSHJ P,MAKTRM ;make it
TTYUUO 3,[ASCIZ/
Type HELP followed by any of the following:
/]
JRST DOIT
>;HELPSW
;UDPASS UENLOS NOTRGT PMATCH PASS2 PASJ1 PASJ GETPAS
;UDPASS, PASCHK, GETPAS
;Here we check a password for the UDP
IFN UDPSW,<
UDPASS: SKIPE PASFLG
JRST SPOPJ1 ;SUCCESS ALREADY
CAIA
UENLOS: TTYUUO 11, ;FLUSH TYPE AHEAD
OUTSTR[ASCIZ/Write password for UDP = /]
PUSHJ P,GETPAS ;Read password from TTY
CAIE BRK,12 ;MUST END WITH THIS
JRST NOTRGT ;LOSE
MOVE WRD
PUSHJ P,UDPCHK
JRST [ JUMPE WRD,CPOPJ ;LET HIM OUT IF BLANK BUT NOT RIGHT
NOTRGT: OUTSTR[ASCIZ/Wrong, try again!
/]
JRST UENLOS]
OUTSTR[ASCIZ/
/]
JRST SPOPJ1
>;UDPSW
;This routine checks to see if the output area you have selected is protected.
;PPN is expected to be in wrd.
;it does a skip return if the is no password or if you type the correct one.
;it doesn't skip if you type cr to it.
IFN PASSSW,<PASCHK:
SKIPN WRD
DEFPPN WRD,
MOVEM WRD,NDSTRM ;save ppn
CAMN WRD,LSTPAS ;ALREADY PASSED IT?
JRST SPOPJ1 ;YES
CALLI WRD,24 ;CURRENT LOSER
CAMN WRD,NDSTRM ;SAME GUY?
JRST SPOPJ1 ;INSTANT SUCCESS
PUSHJ P,DCHK ;TRY TO GET A DISK!
JRST [ OUTSTR[ASCIZ/Can't get a disk to check the password!
/]
HALT PASJ] ;GIVE LOSE RETURN
SETZ WRD, ;CHECK FOR 0 PASSWORD
PUSHJ P,CHKPAS
JRST [ OUTSTR[ASCIZ/The UFD you have requested does not exist at this time!
/]
HALT PASJ]
JRST PASJ1 ;NO PASSWORD
PMATCH: TTYUUO 3,[ASCIZ/Password for /] ;Q the user.
PPNOUT NDSTRM ;print ppn!
TTYUUO 1,["="] ;=
PUSHJ P,GETPAS ;Read password from TTY
MOVE WRD,T ;GET RIGHT ADJUSTED VERSION
TTYUUO 3,[ASCIZ/
/] ;give <cr><lf>.
CAIE BRK,12 ;brk character better be lf.
JRST PASS2 ;nope
JUMPE WRD,PASJ ;IF HE TYPES BLANK NOW, LET HIM OUT
PUSHJ P,CHKPAS ;CHECK PASSWORD IN T
HALT PASS2 ;WE ALREADY LOOKED ONCE, THIS SHOULDN'T HAPPEN
JRST PASJ1 ;equal.
PASS2: TTYUUO 3,[ASCIZ/Wrong, try again.
/]
JRST PMATCH
PASJ1: MOVE WRD,NDSTRM
MOVEM WRD,LSTPAS
AOS (P)
PASJ: RELEASE PCHN,
POPJ P,
;Routine to read password from TTY using GETWRD
GETPAS: PTYUUO 16,[0↔3] ;DUPLEXING OFF!
PPIOT 6,1400 ;POSITION OFF TOP!
PUSHJ P,GETWRD ;get what the user thinks is the password.
HRROI T5,[010000,,0] ;One function (010) for TTYSET
TTYSET T5, ;Disable CONTROL-CR once to avoid showing password
PPIOT 6,0 ;RESET LINE EDITOR POS
PTYUUO 16,[0↔4] ;DUPLEXING ON!
POPJ P,
;CHKPAS DCHK
;CHKPAS
;read password from users ufd!
CHKPAS: MOVEM WRD,PASWRD
MOVE T,NDSTRM
MOVEM T,PASNAM
MOVE T,[MFDPPN]
MOVEM T,PASNAM+3
SETZM PASNAM+2
MOVSI T,'UFD'
MOVEM T,PASNAM+1
LOOKUP PCHN,PASNAM
POPJ P, ;LOSE (NO SUCH UFD)!
AOS (P) ;AT LEAST ONE SKIP
IFE DECSW,< MOVNI T,1
SETPRV T, ;IS THIS GUY A LOCAL USER?
TLNE T,1 ;IF LUP BIT IS ON AND UFD PROTECTION
SKIPL PASNAM+2 ; HAS 400 BIT ON, DON'T ASK
JRST .+2
POPJ P,
>;IFE DECSW
MTAPE PCHN,CMDLST ;HOW ABOUT THE AREA IN QUESTION
AOS (P) ;WRONG
POPJ P,
DCHK: MOVEM T,PASDEV+1
OPEN PCHN,PASDEV
POPJ P,
CHNSTS PCHN,T
TRNN T,SYSDEV ;IS THIS REALLY DEV SYS?
JRST SPOPJ1 ;DEVICE IS DISK
MOVSI T,'DSK'
MOVEM T,PASDEV+1
JSR T,DEVBIT
TLNE T,DSKDEV ;IS IT A DISK?
OPEN PCHN,PASDEV
POPJ P,
CHNSTS PCHN,T
TRNN T,SYSDEV
AOS (P) ;NOT SYS:
POPJ P,
>;PASSSW
;HPRINT DSKDHK HPRIN2 <A HDZ ISHEAD ISHD1 HDIS MTDTHD UDPHD DSKHDL DSKFIN DSKHDS PDVTIM DATIME
;LISTING HEADER SETUP
HPRINT: TLNN TSWTCH,LSTSWT ;ANY LISTINGS?
POPJ P, ;NO
TRNN TSWTCH,S ;HEADINGS FOR S ONLY
JRST HD0
TRNE TSWTCH,F!Q ;NO PRINTING FOR THESE
JRST HD1
TLNE DEVCHR,DTADEV
JRST HD2
TLNE DEVCHR,MTADEV
JRST HD3
IFN UDPSW,<
TLNN DEVCHR,DSKDEV
JRST HD6
DSKDHK:
>;UDPSW
TLNE TSWTCH,TTYSWT
JRST HPRIN2
SETOM TIMFLG ;NOT LISTING ON TTY, OR SPECIAL, GIVE HIM THE WORKS
SETOM PROFLG
SETOM UPRFLG ;Give directory protection & default protection
IFN STANSW,<
SETOM WRIFLG
SETOM REFFLG
SETOM DMPFLG
SETOM OFFFLG
>;STANSW
SETOM FULFLG
HPRIN2: SKIPE FULFLG ;FULL TYPEOUT?
JRST HD4 ;YES
JRST HD5 ;NO
DEFINE HEADS
<
HMAC HD0,CPOPJ,PPMAYB
HMAC HD1,CRLF,CRLF
HMAC HD2,MTDTHD,HMDTA
HMAC HD3,MTDTHD,HMDTA
HMAC HD4,DSKHDL,HFULL
HMAC HD5,DSKHDS,HSHORT
IFN UDPSW,<
HMAC HD6,UDPHD,HFULL
>;UDPSW
>
DEFINE HMAC(A,B,C)
<A: JSP T,ISHEAD
>
;HERE IS THE DISPATCH
HDZ: HEADS
ISHEAD: MOVEI T,-HDZ-1(T) ;GET OFFSET(WITHOUT PC FLAGS)
TLNE DEVCHR,DSKDEV ;MUST BE THESE
SKIPA T2,SOURCE+3 ;GET CURRENT PPN
SETO T2, ;USE THIS IF NO PPN
CAMN T2,DFTPPN ;SAME AS LAST?
JRST ISHD1
HRLM T,(P)
PUSHJ P,KPRIN
HLRZ T,(P)
ISHD1: CAMN T,LASTHD ;NEW HEADING?
POPJ P,
MOVEM T,LASTHD
PUSHJ P,KPRIN ;MAKE SURE THIS IS OUT
MOVE T,LASTHD
JRST @HDIS(T) ;YES
DEFINE HMAC(A,B,C)
< B
>
HDIS: HEADS
MTDTHD: PUSHJ P,PDVTIM
SEVSTR[ASCIZ/
Filename.ext Last written
/]
POPJ P,
IFN UDPSW,<
UDPHD: SIXSTR IDEV+1
SEVSTR [ASCIZ/: /]
PUSHJ P,UDPBIT ;GET FREE BLOCK COUNT
MOVE T,0
PUSHJ P,RADX10
SEVSTR[ASCIZ/. Free blocks
/]
>;UDPSW
DSKHDL: PUSHJ P,DATIME
IFE PPNSW,<
; SKIPN FOOTMP ;LEAVE OUT SOME SPACES FOR UDP
; SEVSTR[ASCIZ/ /]
SEVSTR[ASCIZ/
Filnam Ext P PN Size Written /]
>;PPNSW
IFN PPNSW,<
; SKIPN FOOTMP
; SEVSTR[ASCIZ/ /]
SEVSTR[ASCIZ/
Filnam Ext PPN Size Written /]
>;PPNSW
DSKFIN: SKIPE TIMFLG
SEVSTR [ASCIZ/ Time/]
SKIPE PROFLG
SEVSTR [ASCIZ/ Pro/]
IFN STANSW,<
SKIPE WRIFLG
SEVSTR [ASCIZ/ Writer /]
SKIPE REFFLG
SEVSTR [ASCIZ\ Reference--%\]
SKIPE DMPFLG
SEVSTR [ASCIZ/ Dumped/]
SKIPE OFFFLG
SEVSTR [ASCIZ/ Off/]
>;STANSW
SEVSTR[ASCIZ/
/]
POPJ P,
DSKHDS: PUSHJ P,DATIME
SEVSTR[ASCIZ/
Filnam Ext Size Written /]
SETOM TIMFLG ;Now that we always set this flag, it could be removed.
JRST DSKFIN
PDVTIM: SIXSTR IDEV+1
SEVSTR[ASCIZ/: /]
DATIME: CALLI T,14
PUSHJ P,DATOUT ;print date.
SEVSTR[ASCIZ/ /]
CALLI T,22
IDIVI T,=3600
IFN DECSW,<JRST TIMOUT>
IFE DECSW,<
PUSHJ P,TIMOUT ;and time
SETZM FOOTMP
MOVEI T,FI ;WHAT'S THE INPUT DEVICE?
DEVCHR T,
TLC T,300000
TLNE T,300000 ;IS IT A NEW-STYLE UDP?
POPJ P, ;NO, SO MUCH FOR THAT
SEVSTR [ASCIZ /
/]
MOVEI T,FI
PNAME T,
JFCL ;WHAT YOU MEAN NO SUCH DEVICE!
MOVEM T,FOOTMP#
SIXSTR FOOTMP ;TYPE THE DEVICE NAME
SEVSTR [ASCIZ / (/]
MTAPE FI,[ 'GODMOD'
23 ;SATID
FOOTMP ]
SIXSTR FOOTMP
SEVSTR [ASCIZ /): /]
MTAPE FI,[ 'GODMOD'
22 ;FREE BLOCKS
FOOTMP ]
MOVE T,FOOTMP
PUSHJ P,RADX10
SEVSTR [ASCIZ /. Free tracks/]
SETOM FOOTMP ;DI/FULL USES THIS FLAG FOR SPACING
POPJ P,
>;IFE DECSW
;EXSTK OWAIT NXGPST EX2A EX2 XGPFN1 XGPFN2 XGPFN3 XGPFN4 FCSEL XFCEXT XFCNUM EX2B EX2C IWAIT
;INIT INPUT AND OUTPUT - EXSTK OWAIT NXGPST EX2A EX2 XGPFN1 XGPFN2 XGPFN3 XGPFN4 FCSEL XFCEXT XFCNUM EX2B EX2C IWAIT
;This is the second level of the execution phase.
;It decides if it has to do mfd or ufd searches.
;It also generates filenames for those who need them.
EXSTK: MOVE T,INFF ;reset ufdff each time
MOVEM T,UFDFF
TRNE TSWTCH,S ;no output for /SEARCH OR /RENAME.
JRST EX2
TLNE TSWTCH,FIRST ;first time?
JUMPL TSWTCH,EX2 ;and plsmod then no open.
MOVEI T,EVEN!D800 ;get magtape bits
AND T,DESTIN+2 ;output switches were saved here!
TRNE TSWTCH,IMAGE ;ascii input mode?
IORI T,13 ;no, make it binary mode.
TLNN OUTCHR,MTADEV
TRZ T,EVEN!D800 ;clear these if not magtape
IFN RETSW,<TLNE OUTCHR,DSKDEV
TRO T,200 ;recover from bad retrieval
>;RETSW
CAMN T,ODEV ;is this different from last time?
JRST EX2 ;no, skip open
IFN DEVWAIT,<
MOVEM T,IOSSAV ;SAVE REAL INIT BITS HERE
MOVE DESTIN+4 ;GET BIT
TRNN DWAIT
TRZA T,DWAITF ;CLEAR WAIT BIT
TRO T,DWAITF ;MAKE HIM WAIT FOR IT
>;DEVWAIT
MOVEM T,ODEV
MOVE T,OUTFF ;make system put buffers
MOVEM T,JOBFF ;at loc in outff
OWAIT:IFN UDPSW,<TLNE OUTCHR,UDEV
UOPEN FO,ODEV >;UDPSW
OPEN FO,ODEV ;open output device.
JRST [ MOVE WRD,ODEV+1
PUSHJ P,NODEV
JRST [ SETOM ODEV ;FLAG NOT OPEN ANY MORE
POPJ P,]
JRST OWAIT]
IFN DEVWAIT,<
MOVE T,IOSSAV
EXCH T,ODEV ;PUT BACK REAL STATUS
IFN UDPSW,<TLNE OUTCHR,UDEV
JRST .+3
>;UDPSW
CAME T,ODEV ;DID WE CHANGE IT?
SETSTS FO,@ODEV ;YES, SET RIGHT STATE OF BIT
>;DEVWAIT
IFN XGPSW,<
TLNN OUTCHR,XGPDEV ;XGP'ING?
JRST NXGPST ;NO
SETZM FCSELB ;ALL FONTS NOW SELECTED TO ID 0
MOVEI 2 ;READ MARGINS
MOVEM MARSET
MTAPE FO,MARSET
MOVE T,ILINES ;INTIAL DEFAULT
MOVEM T,DLINES ;VALUE IF NO SPECIFIED
NXGPST:
>;XGPSW
IFN UDPSW,<TLNN OUTCHR,UDEV ;NO BUFFERS FOR UDP>
TRNE TSWTCH,RE
JRST EX2A
HLRZ DESTIN+5 ;get length., for output term
TLNE OUTCHR,MTADEV ;mtadev?
JUMPN [ HRRM PHONY+1 ;setup special buffers if non-zero
UOUTBF FO,PHONY ;setup buffers
JRST .+2]
IFE STANSW,<
OUTBUF FO,7 ;setup buffers
>;IFE STANSW
IFN STANSW,<
OUTBUF FO,@NBUFS ;use optimum number of disk buffers
>;IFN STANSW
EX2A: MOVE T,JOBFF ;reset all the buffers that follow
MOVEM T,INFF
MOVEM T,UFDFF
IFN PASSSW,<
TLNE OUTCHR,DSKDEV
TLNE TSWTCH,DELSWT ;DELETE IS CHECKED LATER ON
CAIA
JRST [ MOVE T,ODEV+1
MOVE WRD,DESTIN+3
PUSHJ P,PASCHK ;check password for disk and stanford only.
JRST DIE ;didn't know password.
JRST .+1]
>;PASSSW
EX2:
IFN XGPSW,<
TLNE OUTCHR,XGPDEV ;XGP
TRNE TSWTCH,IMAGE ;AND NOT IMAGE MODE
JRST EX2B ;NO
SETZM FCSELT ;INIT TEMP CELL
XGPFN1: MOVE T,XGPPTR
ILDB T2,T
JUMPE T2,XGPFN2 ;DONE
MOVEM T2,FCDNAM
ILDB T2,T
HLLZM T2,FCDEXT
HRRZM T2,FCDNUM
ILDB T2,T
MOVEM T2,FCDPPN
MOVEM T,XGPPTR
MOVE T,FCDNUM ;ID NUMBER
MOVE T2,FCBITS(T) ;PICKUP BIT
IORM T2,FCSELT ;OR IN NEW BIT
PUSHJ P,FCSEL ;DO FONT SELECT
JRST XGPFN1
XGPFN2: SETZM FCDNAM ;INDICATE FONT RESET
MOVE T,FCSELT ;PICKUP BITS FOR NON DEFAULT FONTS
EXCH T,FCSELB ;SET THEM AS CURRENT
ANDCM T,FCSELB ;OF FONTS WHICH ARE OFF, WHICH SHOULD BE
MOVEM T,FCSELT
XGPFN3: MOVE T,FCSELT
JFFO T,XGPFN4
JRST EX2B ;DONE
XGPFN4: TDZ T,FCBITS(T2)
MOVEM T,FCSELT
MOVEM T2,FCDNUM
PUSHJ P,FCSEL ;RESET FONT
JRST XGPFN3
FCSEL: MTAPE FO,FCDOIT
CAIA
POPJ P,
SKIPN FCDNAM
JRST [ OUTSTR[ASCIZ/Font reset /]
JRST XFCNUM]
SIXOUT FCDNAM
SKIPN FCDEXT
JRST XFCEXT
OUTCHR["."]
SIXOUT FCDEXT
XFCEXT: SKIPN WRD,FCDPPN
MOVE WRD,['XGPSYS']
OUTCHR["["]
PPNOUT WRD
OUTCHR["]"]
XFCNUM: OUTCHR["#"]
MOVE T,FCDNUM
PUSHJ P,R10TTY
OUTSTR[ASCIZ/, /]
PUSHJ P,FCERRP ;GET ERROR CODE FROM SYSTEM AND PRINT IT
PUSHJ P,[RECMES(,IDEV+1,DESBUF,<. Type Y to go on without this font.>,1)]
JRST QUIT
POPJ P,
EX2B: TLNN OUTCHR,XGPDEV ;XGP OUTPUT?
JRST EX2C
TRNN PRO,ISPACE ;IS THIS IT?
SKIPA T,DLINES ;NO, USE DEFAULT
LDB T,[POINT 6,DFTLIN,35];YES, GET /EXTRA≡
CAMN T,ILINES ;ALREADY CORRECT?
JRST EX2C ;YES, NO CHANGE
MOVEI 2 ;READ MARGINS
MOVEM MARSET
MTAPE FO,MARSET
MOVEM T,ILINES ;SET NEW INTERLINE SPACING
MOVEI 3 ;SET MARGINS
MOVEM MARSET
MTAPE FO,MARSET
EX2C:
>;XGPSW
MOVE T,TSWTCH
ANDI T,EVEN!D800!IMAGE ;get open bits from tswtch.
TRZN T,IMAGE
TRNE TSWTCH,DU
TRO T,13
TLNN DEVCHR,MTADEV
TRZ T,EVEN!D800
IFN RETSW,<TLNE DEVCHR,DSKDEV
TRO T,200 ;turn on for disk
>;RETSW
IFN DEVWAIT,<
MOVEM T,IOSSAV
TRNN PRO,DWAITF ;DOES HE WANT TO WAIT?
TRZA T,DWAITF
TRO T,DWAITF
>;DEVWAIT
MOVEM T,IDEV ;to mem
MOVE T,INFF
MOVEM T,JOBFF
IWAIT:IFN UDPSW,<TLNE DEVCHR,UDEV
UOPEN FI,IDEV >;UDPSW
OPEN FI,IDEV ;open input device
JRST [ MOVE WRD,IDEV+1
PUSHJ P,NODEV
POPJ P,
JRST IWAIT]
IFN STANSW,<
IFDEF SHOWIT,<
MOVE T,IDEV
TRNN TSWTCH,S ;Don't showit for DIRECTORY cmd
TRNN T,10 ;IS IT A NON-ASCII MODE?
JRST .+3
MOVEI T,FI ;YES
SHOWIT T, ;INCLUDE THIS FILE IN WHOLINE
>;IFDEF SHOWIT
>;STANSW
IFN DEVWAIT,<
MOVE T,IOSSAV
EXCH T,IDEV
IFN UDPSW,<
TLNE DEVCHR,UDEV
JRST .+3
>;UDPSW
CAME T,IDEV
SETSTS FI,@IDEV ;RESET TO PROPER STATUS
>;DEVWAIT
IFN UDPSW,<TLNN DEVCHR,UDEV>
TRNE TSWTCH,S!RE
JRST EX4
HLRZ DFTLIN
TLNE DEVCHR,MTADEV ;legal only for magtape
JUMPN [ HRRM PHONY+1 ;setup if non-zero
UINBF FI,PHONY
JRST .+2]
IFE STANSW,<
INBUF FI,7 ;setup buffers
>;IFE STANSW
IFN STANSW,<
INBUF FI,@NBUFS ;use optimum number of disk buffers
>;IFN STANSW
;EX4 NOSRCH GOTPPN GEN1 GEN5 GEN2 DIRSRC
;CHECK FOR *'S
EX4: MOVE T,JOBFF ;reset ufdff
MOVEM T,UFDFF
SETZM MFDBUF+3
TLNN DEVCHR,DSKDEV
JRST NOSRCH
TRNE PRO,PSTR!PNSTR ;P OR PN WAS *?
JRST GETMFD
NOSRCH: MOVE DESBUF+3
MOVEM SOURCE+3
PUSHJ P,HPRINT ;CHECK AND PRINT HEADERS
GOTPPN: TLNE PRO,TOT
PUSHJ P,PTERM
TRNE TSWTCH,SAV ;/SAVE?
TLNN DEVCHR,MTADEV ;magtape only
CAIA
JRST MTAUFD ;make believe magtape has dir.
TLNE DEVCHR,DIRDEV ;if no dir we must invent source stuff.
JRST DIRSRC
JUMPL TSWTCH,BOTTLENECK ;OOPS, PLSMOD
HLRZ DESBUF+1 ;non-directory device.
TRNE PRO,EXTSTR ;ext was star?
HLRZ EXTGEN ;generated extension.
HRLZM EXTGEN ;stow it.
HRLZM SOURCE+1 ;to lookup block
MOVE DESBUF ;filename
TRNN PRO,NAMSTR
JRST [ MOVEM NAMGEN ;save filename
JRST GEN2] ;use it
MOVE T,[POINT 6,NAMGEN,35];have to make one
MOVEI T2,6
GEN1: LDB T3,T ;byte from right to left.
JUMPE T3,[ADD T,[060000000000];decrement byte pointer.
SOJA T2,GEN1] ;get non-zero byte.
GEN5: AOJ T3, ;make name with larger char.
CAIG T3,72 ;to big?
JRST [ DPB T3,T ;no.
JRST GEN2] ;done.
MOVEI T3,'A' ;reset to A
DPB T3,T ;stow it
ADD T,[060000000000] ;decrement byte pointer.
LDB T3,T ;get byte
SOJG T2,GEN5 ;get another.
GEN2: MOVE NAMGEN ;get generated name.
MOVEM SOURCE ;to source
CALLI T,22 ;make it current date and time
IDIVI T,=3600
LDB T2,[POINT 3,T,23]
DPB T2,[POINT 3,SOURCE+1,20]
CALLI T2,14
DPB T2,[POINT 11,T,23]
MOVEM T,SOURCE+2
JRST BOTTLENECK
DIRSRC:
IFN UDPSW,<
TLNE DEVCHR,UDEV
TRNN PRO,PSTR!PNSTR ;CHECK THESE HERE
CAIA
JRST GETUFD
>;UDPSW
TRNN PRO,NAMSTR!EXTSTR
TRNE TSWTCH,F
JRST GETUFD
MOVE DESBUF
MOVEM SOURCE
MOVE DESBUF+1
HLLZM SOURCE+1
;NODMPB NODMPC FILFIX NODMPD NODSKI FILFX1 NOK
;LOOKUP FILE
BOTTLENECK:
TRNE TSWTCH,F
JRST NOK
MOVE WRD,SOURCE+3
MOVEM WRD,PPNTMP
IFN STANSW,<
TRNE TSWTCH,S ;ONLY FOR /SEARCH
TLNN DEVCHR,DSKDEV ;DISK ONLY
JRST NODMPB ;NO
MOVE T,IDEV
; SETSTS FI,400(T) ;SET DMPBIT
NODMPB:
>;STANSW
IFN UDPSW,<TLNE DEVCHR,UDEV
ULOOK FI,SOURCE >;UDPSW
caia; LOOKUP FI,SOURCE ;lookup input file.
JRST [
IFN STANSW,<
TRNE TSWTCH,S
TLNN DEVCHR,DSKDEV
JRST NODMPC
; SETSTS FI,(T) ;TURN OFF DMPBIT
NODMPC:
>;STANSW
HRRZ T,SOURCE+1 ;lookup failed.
SKIPE MFDBUF+3
JUMPE T,CPOPJ ;SUPPRESS "FILE NOT FOUND" FOR MFD SEARCHES
IFN HELPSW,<TLNE TSWTCH,HLPSWT
JUMPE T,[ERRMES(<Type HELP(CR) to see list.>)] >;HELPSW
PUSHJ P,MESS22
TLNE TSWTCH,DELSWT
CAIE T,11 ;BAD RETRIEVAL ON FILE?
CAIA
JRST FILFIX
PUSHJ P,[RECMES(,IDEV+1,SOURCE,Type Y to go on.)]
JRST QUIT
POPJ P,
FILFIX: PUSHJ P,[RECMES(,IDEV+1,SOURCE,Type Y to try to DELETE it anyway.,-1)]
POPJ P,
JRST FILFX1] ;TRY THE DELETE
IFN STANSW,<
TRNE TSWTCH,S
TLNN DEVCHR,DSKDEV
JRST NODMPD
; SETSTS FI,(T) ;TURN OFF DMPBIT
NODMPD:
>;STANSW
IFN STANSW,<
MOVEI T,1
TLC TSWTCH,PLSMOD!FIRST
TLCN TSWTCH,PLSMOD!FIRST
JRST NODSKI ;DON'T USE OFFSET ON CONCATENATE AFTER FIRST TRANSFTER
TLNN DEVCHR,DSKDEV
JRST NODSKI
jfcl; MTAPE FI,RDOFF
MOVE T,OFFSET
NODSKI: MOVEM T,SETOFF
SUBI T,1
MOVEM T,CUROFF
SUBI T,1
MOVN T,T
HRRZM T,USETP
; TLNE DEVCHR,DSKDEV
; USETI FI,@USETP
>;STANSW
FILFX1: MOVE PPNTMP ;get PPN.
EXCH SOURCE+3 ;restore to source+3.
IFN DECSW,< SKIPE 0
TRO -1
>;DECSW
MOVS T,0 ;stupid dec
MOVN T,T ;again
IFN STANSW,<
TLNE DEVCHR,DSKDEV
MOVE T,REALLN ;THIS IS THE REAL LENGTH OF THE FILE
>;STANSW
MOVEM T,SAVK
TRNE TSWTCH,S ;searching?
TLNN DEVCHR,DSKDEV!UDEV ;YES, DISK OR UDP?
JRST NOK
IFN STANSW,<
SKIPE BIGNLY
CAML T,BTHRES ;Is this file big enough?
CAIA
POPJ P, ;No, only want to list big files
SKIPE OFFNLY
SKIPE CUROFF
CAIA
POPJ P, ;Only want to list files w/offset--none here
>;IFN STANSW
PUSHJ P,COUNTK ;count it
TLO TSWTCH,K2 ;we found one
NOK: TLNE PRO,ASK ;/ASK?
JRST [ PUSHJ P,[RECMES(<
>,IDEV+1,SOURCE,?,1)]
JFCL ;IGNORE THIS RETURN
MOVE LSTCHR ;GET CHAR. HE TYPED
ANDI 177 ;DISCARD BUCKY-BITS
CAIE "Y"
CAIN "y"
JRST .+1 ;HE SAID YES, PROCEED
CAIE "G"
CAIN "g" ;G FOR GO ON FROM HERE
TLZA PRO,ASK ;DON'T ASK ANY MORE THIS TERM
POPJ P, ;NOT THIS ONE
JRST .+1]
PUSHJ P,PPTERM
MOVEM P,SAVPC ;REMEBER PDL IN CASE WE DON'T POP BACK TO HERE
TRNE TSWTCH,S
JRST TRANS2
PUSHJ P,TRANS1 ;DO TRANSFER(ERRORS POP PAST HERE).
;EOF TRANS2 NOPLUS NOKILL
;END OF FILE
EOF: MOVE P,SAVPC ;GET PDL BACK, WE RETURN HERE FROM ALL LOWER LEVELS(I HOPE)!
MOVE STK,SAVPGL ;RESET STK AND GOPAGE
ILDB STK
MOVEM GOPAGE
TLNE OUTCHR,TTYDEV ;tty?
JRST [ MOVEI BRK,15
PUSHJ P,SNDCHR ;TO THE LEFT MARGIN
MOVEI BRK,12 ;SPACE DOWN A LITTLE
PUSHJ P,SNDCHR
MOVEI BRK,12
PUSHJ P,SNDCHR
JRST TRANS2]
IFN SPLSW,<
HRRZ BRK,SPLBIT
SKIPGE TSWTCH
JUMPN BRK,[MOVEI BRK,15
PUSHJ P,SNDCHR
MOVEI BRK,177
PUSHJ P,SNDCHR
MOVEI BRK,20
PUSHJ P,SNDCHR
JRST TRANS2]
>;SPLSW
IFN SENDSW,<HLRZ SOURCE+1 ;this part puts the current ppn onto the end of a message.
TLNE TSWTCH,SNDSWT ;SEND?
SKIPE MESFLG ;AND NOT ∂ PHRAMIS
JRST TRANS2
TLNN DEVCHR,TTYDEV
JRST TRANS2
MOVEI BRK,15
PUSHJ P,SNDCHR
MOVEI BRK,12
PUSHJ P,SNDCHR
PUSHJ P,PDT ;PRINT DATE AND TIME
>;SENDSW
TRANS2:
TLNE PRO,H ;IF DOING HEADERS THEN,
TLNN OUTCHR,LPTDEV ;LPT NEEDS CLOSE SO FF WILL HAPPEN
JUMPL TSWTCH,NOPLUS
IFN UDPSW,<
TLNE OUTCHR,UDEV ;UDP?
UCLOSE FO, ;YES, CLOSE IT
>;UDPSW
CLOSE FO,
IFN SPLSW,<
HRRZ T3,SPLBIT ;GET OUTPUT BITS
JUMPE T3,NOPLUS ;JUMP IF NOT SPOOLING
MOVEI T2,OBUF ;POINTER TO NAME
PUSHJ P,SPLMAK
>;SPLSW
NOPLUS: TLO TSWTCH,FIRST ;NO LONGER FIRST TERM.
TRNN TSWTCH,K ;are we killing?
JRST NOKILL
PUSHJ P,KILFIL
POPJ P, ;KILL LOST, NO LISTING
NOKILL: TLNE TSWTCH,DIRSWT ;DON'T CHECK Q IF NOT DIR
TRNN TSWTCH,Q
TRNN TSWTCH,L ;/LIST?
POPJ P, ;NO LISTING.
;HPDIS HMDTA HSHORT HFULL HFULL1 HFULL2 HFULL3 HFULL4 HFULL5 HFUL5A HFUL5B HFULL6 HFULL7 CRLF PPMAYB PPONLY COUNTK FILL
;LISTING OUTPUT
TRNN TSWTCH,K
TLNE TSWTCH,DELSWT
SEVSTR [ASCIZ/Deleted:/] ;FILE WAS DELETED.
SETZM CHRCNT
SIXSTR SOURCE
IFN FOOSW,<
MOVEI BRK,"."
TRNE PRO,FOOSWT
XCT ALTDEV
>;FOOSW
MOVEI T3,7
IFN FOOSW,<
TRNN PRO,FOOSWT
PUSHJ P,FILL
>;FOOSW
SETZM CHRCNT
HLLZ WRD,SOURCE+1
SIXSTR WRD
TDNE TSWTCH,[DELSWT,,K] ;DELETE OR TRAN?
JRST PPMAYB
IFN UDPSW,<
TDNE TSWTCH,[XWD DELSWT,F] ;IF DELETING OR DOING FAST
TLNN DEVCHR,UDEV ;FROM UDP
CAIA
JRST PPONLY ;ADD PPN AND LEAVE
>;UDPSW
IFN FOOSW,<TRNE PRO,FOOSWT
JRST [ MOVEI BRK,"["
XCT ALTDEV
PPNSTR SOURCE+3
MOVEI BRK,"]"
XCT ALTDEV
JRST CRLF]
>;FOOSW
MOVE T,LASTHD
JRST @HPDIS(T)
DEFINE HMAC(A,B,C)
< C
>
HPDIS: HEADS
HMDTA: MOVEI T3,5
PUSHJ P,FILL
PUSHJ P,DATOU2
JRST CRLF
HSHORT: MOVEI T3,4
JRST HFULL1
HFULL: MOVEI T3,4
PUSHJ P,FILL
SETZM CHRCNT
MOVE WRD,SOURCE+3
MOVEM WRD,DFTPPN
SKIPN WRD
DEFPPN WRD,
IFN PPNSW,<SIXSTR WRD
>;PPNSW
IFE PPNSW,<MOVE ALT,ALTDEV
HLRZ T,WRD
PUSHJ P,OCTOUT
MOVEI T3,7
PUSHJ P,FILL
SETZM CHRCNT
HRRZ T,WRD
PUSHJ P,OCTOUT
>;PPNSW
MOVEI T3,7
HFULL1: PUSHJ P,FILL
PUSHJ P,KOUT0
SEVSTR[ASCIZ/ /]
PUSHJ P,DATOU2
SKIPN TIMFLG
JRST HFULL2
SEVSTR[ASCIZ/ /]
PUSHJ P,TIMOU2 ;and time last written
HFULL2: SKIPN PROFLG
JRST HFULL3
SEVSTR[ASCIZ/ /]
PUSHJ P,PPRO ;and PROTECTION
HFULL3: TLNN DEVCHR,DSKDEV
JRST CRLF
IFN STANSW,<
SKIPN WRIFLG
JRST HFULL4
MTAPE FI,RDRETR
JRST [ SEVSTR [ASCIZ/ /];MTAPE FAILED
JRST HFULL4]
MOVEI BRK,40
XCT ALTDEV
MOVE WRD,RETRBF+DQINFB+1 ;PPN OF FILE WRITER
SETZM CHRCNT
SIXSTR WRD
MOVEI T3,7
PUSHJ P,FILL
SETZM CHRCNT
MOVE WRD,RETRBF+DQINFB ;JOBNAME OF WRITER
SIXSTR WRD
MOVEI T3,6
PUSHJ P,FILL
HFULL4: SKIPN REFFLG
JRST HFULL5 ;NO REF DATE THIS TIME
MOVEI BRK,40
XCT ALTDEV
MOVE T,SOURCE+4
ANDI T,77777 ;Clear the reference count field
PUSHJ P,DATOUT ;And print only the reference date
REPEAT 0,< ;For now, don't print the actual count
HLRZ T,SOURCE+4 ;Get ref count
PUSHJ P,LEAD4 ;Prepare to print in 4 cols (no extra space!)
PUSHJ P,RADX10 ;Print ref count
>;REPEAT 0
MOVE T,SOURCE+2 ;GET DATE
LDB T2,[POINT 3,SOURCE+1,20]
DPB T2,[POINT 3,T,23]
ANDI T,77777 ;Mask only date written
DAYCNT T,
DATE T2,
DAYCNT T2,
CAIGE T,12763 ;DAYCNT date when we started counting ref days
MOVEI T,12763
CAIGE T2,12763
MOVEI T2,12763
SUB T2,T ;Number of possible days referenced
MOVEI BRK," "
XCT ALTDEV
JUMPLE T2,[SEVSTR [ASCIZ/ /] ;New file has no avg at all
JRST HFULL5]
HLRZ T,SOURCE+4 ;Ref count again
IMULI T,=100
IDIVI T,(T2) ;Batting avg of reference days
CAIL T,=100
MOVEI T,=99
PUSHJ P,LEAD40 ;Use leading zeroes
PUSHJ P,RADX10 ;Print batting avg
HFULL5: SKIPN DMPFLG
JRST HFULL6
SKIPN T,SOURCE+5 ;DATE LAST DUMPED.
JRST [ SKIPN T,CUROFF
JRST CRLF ;AVOID SPACES AT END OF LINE
SEVSTR[ASCIZ/ /] ;NOT DUMPED
JRST HFULL7] ;ONE LABEL SAVES ONE CYCLE
MOVEI BRK,40
XCT ALTDEV
TLNE T,20000 ;DUMP INVALID?
JRST [ TLNN T,10000 ;INVALID. REAP BIT SET?
JRST HFUL5A ;NO
SEVSTR[ASCIZ/Invl R/] ;YES
JRST HFULL6
HFUL5A: SEVSTR[ASCIZ/Invld /]
JRST HFULL6]
REPEAT 0,< ;No one really cares about explicit dump date anyway
PUSHJ P,DATOUT ;PRINT DATE
MOVEI BRK," "
XCT ALTDEV
>;REPEAT 0
SKIPGE T,SOURCE+5 ;INCREMENTAL?
SKIPA BRK,["T"] ;YES
MOVEI BRK,"P" ;NO, PERMANENT
TRNN T,-1 ;EVER DUMPED?
MOVEI BRK," " ;NO, JUST REAPED
XCT ALTDEV ;PRINT T OR P
SETZM CHRCNT
LDB T,[POINT 12,SOURCE+5,20]
JUMPE T,.+2
PUSHJ P,RADX10 ;PRINT TAPE NUMBER
MOVE T,SOURCE+5 ;GET REAP BIT TO TEST
TLNE T,10000
JRST [ MOVEI BRK,"R"
JRST HFUL5B] ;REAPED FILE CAN'T BE TWICE-DUMPED
LDB T,[POINT 3,SOURCE+5,3] ;NUMBER OF PERMANENT DUMPS
MOVEI BRK,76 ;GREATER-THAN SIGN
CAIG T,1
SOSA CHRCNT ;NOT PRINTING IT, PRETEND ONE LESS DIGIT
HFUL5B: XCT ALTDEV ;PRINT GRITCH CHAR IF DUMPED MORE THAN ONCE
MOVEI T3,3 ;FILL OUT IF LESS THAN 3 DIGITS IN TAPE NO.
PUSHJ P,FILL
HFULL6: SKIPN T,CUROFF
JRST CRLF
HFULL7: SKIPN OFFFLG
SEVSTR [ASCIZ/ Offset =/] ;HE DIDN'T ASK FOR IT, BUT GIVE IT TO HIM
MOVEI BRK,40
XCT ALTDEV
PUSHJ P,LEAD4
PUSHJ P,RADX10
>;STANSW
CRLF:
IFN HELPSW,<
TLNE TSWTCH,HLPSWT ;HELPING?
JRST [ AOS T,COLUMN
CAIGE T,10
POPJ P,
SETZM COLUMN
JRST .+1]
>;HELPSW
SEVSTR[BYTE(7)15,12]
POPJ P,
PPMAYB:
IFN HELPSW,<TLNN TSWTCH,HLPSWT> ;NO PPN FOR HELP
SKIPN SOURCE+3
JRST CRLF
PPONLY: MOVEI T3,5
PUSHJ P,FILL
PPNSTR SOURCE+3
JRST CRLF
;COUNT K AND BLOCKS FROM WORD COUNT IN T
COUNTK: ADDM T,TOTALK
IFN UDPSW,<
TLNE DEVCHR,UDEV
SKIPA T3,[BLKLEN+34]
>;UDPSW
IFE STANSW,<
MOVEI T3,BLKLEN
>;IFE STANSW
IFN STANSW,<
MOVE T3,BKDSIZ ;Data word count in one block
>;IFN STANSW
ADDI T,-1(T3)
IDIV T,T3 ;tell me the number of blocks
JUMPN T,.+2
AOJ T, ;FUDGE FOR ZERO K
ADDM T,TOTALK+1 ;add to block total
IMUL T,T3 ;calc total number of words he could be using
ADDM T,TOTALK+2 ;and accumulate here
POPJ P,
FILL: SUB T3,CHRCNT
SKIPA BRK,[40]
XCT ALTDEV
SOJGE T3,.-1
POPJ P,
;PDT KOUT0 KOUT PWORDS LEAD40 LEAD41 LEAD4 LEAD42
;LISTING SUBRS -- PDT, KOUT, PWORDS, LEAD4
IFN SENDSW,<
PDT: MOVE DISP,[PUSHJ P,SNDCHR]
EXCH DISP,ALTDEV
CALLI T,14
PUSHJ P,DATOUT
MOVEI BRK,40
PUSHJ P,SNDCHR
PUSHJ P,SNDCHR
CALLI T,22
IDIVI T,=3600
PUSHJ P,TIMOUT
MOVEI BRK,11
PUSHJ P,SNDCHR
PUSHJ P,SNDCHR
CALLI T2,24
PPNSTR T2
MOVEI BRK,15
PUSHJ P,SNDCHR
MOVEI BRK,12
PUSHJ P,SNDCHR
MOVEM DISP,ALTDEV
POPJ P,
>;SENDSW
KOUT0: MOVE T,SAVK
KOUT: IDIVI T,=1024 ;MAKE INTO K
JUMPE T,PWORDS ;PRINT WORDS IF LESS THAN 1K
PUSH P,T2 ;SAVE FRACTION
PUSHJ P,LEAD4
PUSHJ P,RADX10 ;NOW THAT WE HAVE THE SPACING PRINT THE NUMBER
POP P,T ;GET BACK FRACTION
IMULI T,=10 ;UGH BLETCH
IDIVI T,=1024 ;GET TENTHS
MOVEI BRK,"."
XCT ALTDEV
JRST RADX10 ;AND PRINT
PWORDS: SEVSTR[ASCIZ/ /]
MOVE T,T2
PUSHJ P,LEAD4
JRST RADX10
LEAD40: MOVEI BRK,"0"
JRST LEAD42
LEAD4: MOVEI BRK,40
CAIGE T,=1000
XCT ALTDEV
CAIGE T,=100
XCT ALTDEV
LEAD42: CAIGE T,=10
XCT ALTDEV
POPJ P,
;DATOU2 DATOUT TIMOU2 TIMOUT PPRO PPRO2 PPRO1
; DATOUT, TIMOUT, PPRO
DATOU2: MOVE T,SOURCE+2 ;GET DATE
LDB T2,[POINT 3,SOURCE+1,20]
DPB T2,[POINT 3,T,23]
DATOUT: ANDI T,77777 ;mask only date.
IDIVI T,=31
AOJ T2,
IDIVI T2,12
MOVEI BRK,60(T2)
XCT ALTDEV ;print day.
MOVEI BRK,60(T3)
XCT ALTDEV
MOVEI BRK,"-"
XCT ALTDEV
IDIVI T,=12
SEVSTR DATES(T2) ;print month.
MOVEI BRK,"-"
XCT ALTDEV
ADDI T,=64
IDIVI T,12
MOVEI BRK,60(T)
XCT ALTDEV ;print year
MOVEI BRK,60(T2)
XCT ALTDEV
POPJ P,
TIMOU2: MOVE T,SOURCE+2
LSH T,-14
TIMOUT: ANDI T,3777 ;mask time
IDIVI T,=60
MOVEM T2,WRD
IDIVI T,12
MOVEI BRK,60(T)
XCT ALTDEV ;hour
MOVEI BRK,60(T2)
XCT ALTDEV
MOVE BRK,WRD
IDIVI BRK,12
ADDI BRK,60
XCT ALTDEV ;minute.
MOVEI BRK,60(WRD)
XCT ALTDEV
POPJ P,
PPRO: MOVE T2,SOURCE+2 ;protection and mode
PPRO2: MOVEI T3,3
PPRO1: SETZ T,
LSHC T,3
MOVEI BRK,60(T)
XCT ALTDEV ;print digit.
SOJG T3,PPRO1
POPJ P,
;KILFIL NOCHK NKLUDP MESS22 ERRTAB UNERR MAXERR PPTER0 PPTERM PTERM PTERM2 PTERM1 PTERM3
KILFIL: MOVE WRD,SOURCE+3 ;yes
MOVEM WRD,NULL+3 ;
IFN PASSSW,<
TLNN DEVCHR,DSKDEV ;REALLY DISK?
JRST NOCHK ;NO, NO CHECK
MOVE T,IDEV+1
PUSHJ P,PASCHK ;check password.
POPJ P,
NOCHK:>;PASSSW
IFN UDPSW,<
TLNN DEVCHR,UDEV ;UDP?
JRST NKLUDP ;NO
PUSHJ P,UDPASS ;PASSWORD CHECK
POPJ P, ;DOESN'T KNOW IT
URENAME FI,NULL ;UDP KILL
NKLUDP:>;UDPSW
RENAME FI,NULL ;kill!!!!!
JRST [ HRRZ T,NULL+1 ;oops!
SETZM NULL+1
SETZM NULL+3
PUSHJ P,MESS22
PUSHJ P,[RECMES(Kill failed for ,IDEV+1,SOURCE,Type Y to go on.)]
JRST QUIT
POPJ P,]
SETZM NULL+3
JRST SPOPJ1
MESS22: TTYUUO 13, ;TURN OFF ↑O.
JFCL
CAIL T,MAXERR
MOVEI T,UNERR-ERRTAB
TTYUUO 3,@ERRTAB(T)
OUTSTR[ASCIZ/. /]
POPJ P,
ERRTAB: [ASCIZ/File not found/]
[ASCIZ/Illegal PPN/]
[ASCIZ/Protection failure/]
[ASCIZ/File is being referenced/]
[ASCIZ/File already exists/]
[ASCIZ/No LOOKUP done/]
UNERR: [ASCIZ/Unknown status/]
[ASCIZ/No device on channel/]
[ASCIZ/Bad retrieval in UFD/]
[ASCIZ/Bad retrieval/]
[ASCIZ/Disk is full/]
MAXERR←←.-ERRTAB
;Here to list PPN for [*,X] or [Y,*] before we even look for files on the PPN.
PPTER0: TLNN TSWTCH,LSTSWT ;ANY LISTINGS?
POPJ P, ;NO
PPTERM:
; SKIPN FULFLG
TLNN TSWTCH,TTYSWT
TRNE TSWTCH,Q!F
TRNN TSWTCH,S
POPJ P,
IFN FOOSW,<
TRNE PRO,FOOSWT
POPJ P,
>;FOOSW
MOVE DFTPPN
IFN UDPSW,<TLNN DEVCHR,UDEV ;NOT FOR UDP>
CAMN SOURCE+3
POPJ P,
JRST PTERM1
PTERM: TLNE DEVCHR,DSKDEV
JRST PTERM2
SIXSTR IDEV+1
MOVEI BRK,":"
XCT ALTDEV
PTERM2: SIXSTR DESBUF
MOVEI BRK,"."
SKIPE DESBUF+1
XCT ALTDEV
SIXSTR DESBUF+1
TLO TSWTCH,K2 ;MAKE SURE "TOTAL=" GETS PRINTED.
PTERM1: TLNN DEVCHR,DSKDEV!UDEV
POPJ P,
SEVSTR [ASCIZ/ [/]
PPNSTR SOURCE+3
SEVSTR [ASCIZ/]/]
SKIPN UPRFLG ;Does he get UFD pro?
JRST PTERM3 ;No
SKIPN T,SOURCE+3 ;PPN
DEFPPN T,
MOVEM T,UPRBLK
MOVE T,[MFDPPN]
MOVEM T,UPRBLK+3
MOVE T,IDEV+1 ;BH 9/16/78 I sure hope this is the right place
MOVEM T,UPRDEV+1 ;BH to get this info from!
OPEN UPR,UPRDEV
JRST PTERM3 ;Oh well. No use being fatalistic here.
LOOKUP UPR,UPRBLK ;UFD
JRST PTERM3 ;As I was saying...
SEVSTR [ASCIZ/ UFD Pro=/]
MOVE T2,UPRBLK+2 ;GET PROTECTION WORD
PUSHJ P,PPRO2 ;PRINT PROTECTION
IFN STANSW,<
MTAPE UPR,RDRETR ;Read retrieval
JRST PTERM3 ;This error return should never happen
SEVSTR [ASCIZ/; Def Pro=/]
MOVE T2,RETRBF+DQINFB+1 ;GET DEF PROTECTION WORD
PUSHJ P,PPRO2 ;PRINT DEF PRO
>;STANSW
PTERM3: SEVSTR [ASCIZ/
/]
MOVE SOURCE+3
MOVEM DFTPPN
IFN HELPSW,<
SETZM COLUMN
>;HELPSW
POPJ P,
;GETMFD NOMFD GETPPN NXTWRD JMPIN1 LOADPP PNISTR PISTR
;GETMFD NOMFD GETPPN NXTWRD JMPIN1 LOADPP PNISTR PISTR
;This routine scans the mfd for PPN specified with *'s.
;and then checks to see where to go next.
GETMFD: TLZ TSWTCH,NOANS ;always ask from here on
MOVE DESBUF+3
MOVEM SOURCE+3
PUSHJ P,KPRIN ;CLEAN HOUSE
PUSHJ P,PPTERM
CHNSTS FI,T
TRNE T,SYSDEV ;IS THIS SYSTEM DEVICE?
JRST [ MOVSI T,'DSK'
MOVEM T,MFDDEV+1
JSR T,DEVBIT
TLNN T,DSKDEV
JRST .+1
JRST .+3]
MOVE T,IDEV+1
MOVEM T,MFDDEV+1
OPEN MFD,MFDDEV ;OPEN MFD CHANNEL
JRST [ERR2:ERRMES(INIT failed on disk. You lose.)]
CHNSTS MFD,T
TRNE T,SYSDEV
JRST [ SETZ T,
JRST NOMFD]
MOVE T,UFDFF
MOVEM T,JOBFF
IFE STANSW,<
INBUF MFD,1 ;setup buffers
>;IFE STANSW
IFN STANSW,<
INBUF MFD,@NBUFS ;use optimum number of disk buffers
>;IFN STANSW
MOVE T,JOBFF
MOVEM T,UFDFF
MOVE WRD,[MFDPPN] ;set PPN.
MOVEM WRD,MFDBUF+3 ;
LOOKUP MFD,MFDBUF ;lookup MFD.
JRST [ HRRZ T,MFDBUF+1 ;If you don't find it say why.
NOMFD: PUSHJ P,MESS22
PUSHJ P,[RECMES(LOOKUP of MFD.,IDEV+1,MFDBUF,Type Y to go on.)]
JRST QUIT
POPJ P,]
IFN STANSW,<
IFDEF SHOWIT,<
TRNN TSWTCH,S ;Only show MFD status for DIRECTORY cmd
JRST .+3
MOVEI T,MFD ;YES
SHOWIT T, ;INCLUDE THIS FILE IN WHOLINE
>;IFDEF SHOWIT
>;STANSW
TLZ TSWTCH,NOANS
MOVEI T5,1 ;first time get 1st word.
JRST JMPIN1 ;get in.
GETPPN: MOVEI T5,20 ;skip 17 words.
NXTWRD: SOSLE IMFD+2 ;out of input?
JRST LOADPP ;no
JMPIN1: IN MFD,0 ;get more.
JRST LOADPP ;no errors
STATO MFD,1B22 ;error?
JRST [ PUSHJ P,[RECMES(<MFD input error for >,IDEV+1,DESBUF,<Type Y to go on.>)]
JRST QUIT
POPJ P,]
RELEASE MFD,0 ;no, end of file.
POPJ P,
LOADPP: ILDB WRD,IMFD+1 ;get word.
SOJG T5,NXTWRD ;is it PPN?
JUMPE WRD,GETPPN ;skip zero entries
TRNE PRO,PNSTR ;PN A STAR?
JRST PNISTR ;YES
HRRZ DESBUF+3 ;yes, get what he specified.
CAIE (WRD) ;or right half of wrd.
JRST GETPPN ;no, try again.
PNISTR: TRNE PRO,PSTR
JRST PISTR
HLRZ DESBUF+3 ;left half.
HLRZ T,WRD ;left half of wrd.
CAIE (T) ;p=left half of wrd.
JRST GETPPN ;no, try again.
PISTR: HRRZ T5,IMFD+1 ;get pointer to PPN.
HLRZ 1(T5)
CAIE 'UFD' ;is it UFD.
JRST GETPPN ;no, try again.
MOVEM WRD,SOURCE+3 ;set PPN.
PUSHJ P,HPRINT ;Print titles before first PPN
PUSHJ P,PPTER0 ;Print PPN, even if no files
PUSHJ P,GOTPPN
JRST GETPPN
;GETUFD GETUF1 NOUFD GETN1 GETNXT USKP5 NMISTR EXISTR NOUDEV ADUFD INUFD
;GETUFD
;This routine scans the specified ufd for *'s in filnam.ext.
;then goes to trans.
GETUFD: TLNE DEVCHR,DTADEV ;dectape input?
JRST DTAUFD ;yes, go do right thing.
MOVE T,UFDFF ;this is where to put ufd buffers.
MOVEM T,JOBFF
IFN UDPSW,<TLNN DEVCHR,UDEV
JRST GETUF1
MOVE IDEV+1 ;this seems to be a udp
MOVEM UDPDEV+1
UOPEN UFD,UDPDEV
JRST 4,.
JRST 4,.
ULOOK UFD,-1 ;special access for UDP directory
JRST 4,.
JRST 4,.
MOVEI T5,1
JRST USKP5
GETUF1:>;UDPSW
CHNSTS FI,T
TRNE T,SYSDEV
JRST [ MOVSI T,'DSK'
MOVEM T,UFDDEV+1
JSR T,DEVBIT
TLNE T,DSKDEV
JRST .+3
JRST .+1]
MOVE T,IDEV+1
MOVEM T,UFDDEV+1
OPEN UFD,UFDDEV
JRST ERR2
MOVE WRD,[MFDPPN] ;UFD's are on 1,1.
MOVEM WRD,LUFD+3
CHNSTS UFD,T
TRNE T,SYSDEV
JRST [ SETZ T,
JRST NOUFD]
IFE STANSW,<
INBUF UFD,1 ;setup buffers
>;IFE STANSW
IFN STANSW,<
INBUF UFD,@NBUFS ;use optimum number of disk buffers
>;IFN STANSW
SKIPN T,SOURCE+3 ;get PPN
DEFPPN T,
MOVEM T,LUFD ;put into lookup block.
LOOKUP UFD,LUFD
JRST [ HRRZ T,LUFD+1 ;error.
CAIE T,2 ;Protection failure?
JRST NOUFD ;No
SKIPE UIGFLG ;Yes, want to ignore UFDs protected from us?
POPJ P, ;Yes
NOUFD: PUSHJ P,MESS22 ;tell loser why.
MOVEM WRD,LUFD+3
PUSHJ P,[RECMES(,IDEV+1,LUFD,<Type Y to go on.>)]
JRST QUIT
POPJ P,]
MOVEI T5,1 ;filename is 1st word in file.
GETN1: TLZ TSWTCH,NOANS ;could be more than one.
GETNXT: IFN UDPSW,<TLNE DEVCHR,UDEV
ADDI T5,2
USKP5:>;UDPSW
SOSG IUFD+2 ;test input for data.
PUSHJ P,INUFD
ILDB WRD,IUFD+1 ;get a word.
IFE UDPSW,<SOJG T5,GETNXT> IFN UDPSW,<SOJG T5,USKP5>
HRRZ T5,IUFD+1
JUMPE WRD,ADUFD ;skip nulls
TRNE PRO,NAMSTR ;NAME STAR?
JRST NMISTR ;YES
CAME WRD,DESBUF ;check for match.
JRST ADUFD
NMISTR: MOVEM WRD,SOURCE ;put filename away.
HLRZ WRD,1(T5) ;put in right half.
TRNE PRO,EXTSTR ;EXTENSION STAR?
JRST EXISTR ;YES
HLRZ T,DESBUF+1 ;get your ext in right half of t.
CAME T,WRD ;are they equal.
JRST ADUFD
EXISTR: HRLZS WRD ;put ext back in left half.
HLLZM WRD,SOURCE+1 ;store ext.
IFN UDPSW,<TLNN DEVCHR,UDEV
JRST NOUDEV
SKIPN T3,DESBUF+3
DEFPPN T3,
HLRZ T2,T3
HRRZS T3
MOVE WRD,3(T5)
TRNE PRO,PNSTR
MOVEI T3,(WRD)
CAIE T3,(WRD)
JRST ADUFD
HRRM T3,SOURCE+3
HLRZS WRD
TRNE PRO,PSTR
MOVEI T2,(WRD)
CAIE T2,(WRD)
JRST ADUFD
HRLM T2,SOURCE+3
TRNN TSWTCH,S ;ONLY SEARCHING?
JRST NOUDEV ;NO, MUST DO LOOKUP
MOVE T2,SOURCE+3
MOVEM T2,PPNTMP ;MOVE PPN HERE
MOVN T2,4(T5) ;GET FILE LENGTH
MOVSM T2,SOURCE+3 ;TO LOOKUP BLOCK
MOVE T2,2(T5) ;DATE
MOVEM T2,SOURCE+2
PUSHJ P,FILFX1 ;SNEAK IN HERE
JRST ADUFD ;AND LOOP
NOUDEV:>;UDPSW
PUSHJ P,BOTTLENECK
ADUFD:
IFE DECSW,<
IFN STANSW,<
MOVEI T5,20 ;20 words per file entry at Stanford
TLNE DEVCHR,DTADEV ; except on Dectapes, which have 4 words/file.
>;STANSW
MOVEI T5,4
>;NOT DECSW
IFN DECSW,< MOVEI T5,2> ;2 words per file entry in DEC system
JRST GETNXT
INUFD:IFN UDPSW,<TLNE DEVCHR,UDEV
JRST [ UIN UFD,0
POPJ P,
JRST PPOPJ1] >;UDPSW
IFG OLD,<TLNE DEVCHR,DTADEV
JRST PPOPJ1 >;OLD
IN UFD,0 ;get more.
POPJ P, ;no errors
STATO UFD,1B22 ;error?
JRST [ PUSHJ P,[RECMES(<Directory input error for >,IDEV+1,DESBUF,<Type Y to go on.>)]
JRST QUIT
POPJ P,]
RELEASE UFD,0 ;end of file.
JRST PPOPJ1
;DTAUFD GETN2
;DTAUFD
;This does old format dectape directory searches. (Loser)!
IFG OLD,<
DTAUFD: MOVE IDEV+1 ;dectape name.
MOVEM DTAIN1+1
OPEN UFD,DTAIN1
JRST DERR
MOVE T,UFDFF ;put buffer here
MOVEM T,JOBFF
INBUF UFD,1 ;one buffer.
USETI UFD,1 ;dir on blk 1.
IN UFD, ;read it.
CAIA
JRST [DERR:STATZ UFD,1B22;error
JRST .+1
PUSHJ P,[RECMES(Directory input error ,IDEV+1,DESBUF,<Type Y to go on.>)]
JRST QUIT
POPJ P,]
OPEN FI,IDEV ;reopen on input channel.
JRST DERR
MOVEI 175
MOVEM IUFD+2 ;set number of words left.
TRNN TSWTCH,S
JRST GETN2
HLRZ T5,@IUFD+1 ;print num of free blocks left.
SOJ T5,
MOVEI T,=576
SUB T,T5
SKIPGE T
SEVSTR [ASCIZ/-/] ;may be negative HO HO!
MOVMS T
PUSHJ P,RADX10
SEVSTR [ASCIZ/. Free blocks left.
/]
GETN2: MOVEI T5,5 ;5th word is first file.
JRST GETN1
>;OLD
;DTAUFD
;DTAUFD (NEW?)
;This will do directory searches for either new or
;old dectape formats. When the format is in.
;this guy probably won't work until andy settles down.
IFE OLD,<
DTAUFD: MOVE IDEV+1
MOVEM DTAIN1+1
OPEN UFD,DTAIN1
JRST ERR2
MOVE T,UFDFF
MOVEM T,JOBFF
INBUF UFD,1
USETI UFD,=100
IN UFD,
CAIA
JRST [PUSHJ P,[RECMES(Directory error for,IDEV+1,DESBUF,Type Y to go on.)]
JRST QUIT
POPJ P,]
MOVEI T5,1 ;1st word is filname.
JRST GETN1 >;OLD
;MTANXT MTAUF1 MTAUFD
;MTAUFD
;read save files.
;first four words of file tell the following:
; filename
; ext.
; date and time file last written(from lookup).
; zero
MTANXT: STATZ FI,1B22 ;end of file?
JRST MTAUF1 ;yes, read next one.
IN FI, ;no, input until eof
JRST .-1
JRST MTANXT ;maybe an error?
MTAUF1: CLOSE FI, ;hmm!
MTAUFD: TLO DEVCHR,SAVBIT ;tell inhim to come back here on end of file.
PUSHJ P,INHIM ;read one record
TLZ DEVCHR,SAVBIT ;tell him different
AOS IFIL+1
MOVE BRK,@IFIL+1 ;all this in case we're in ascii mode
MOVEM BRK,SOURCE
AOS IFIL+1
MOVE BRK,@IFIL+1
MOVEM BRK,SOURCE+1
AOS IFIL+1
MOVE BRK,@IFIL+1
MOVEM BRK,SOURCE+2
AOS IFIL+1
SETZM SOURCE+3
MOVNI 3
MOVE T,IDEV
TRNN T,10
MOVNI =19
ADDM IFIL+2 ;kludge up word count
SKIPN WRD,DESBUF ;now check if we want this file.
JRST MTANXT ;skip 0
TRNN PRO,NAMSTR
CAMN WRD,SOURCE
CAIA
JRST MTANXT
HLLZ WRD,DESBUF+1
HLLZ BRK,SOURCE+1
TRNN PRO,EXTSTR
CAMN WRD,BRK
CAIA
JRST MTANXT
TLO DEVCHR,DIRDEV ;make him list file if /LIST
PUSHJ P,NOK ;SKIP LOOKUP OR WE GET FUCKED!!!!!!!!!
TRNN PRO,NAMSTR!EXTSTR
POPJ P,
JRST MTANXT ;GO ON ONLY IF MORE THAN ONE FILE REQUESTED.
;TRANS1 TRANS4 TRAN6 TRAN5 NOOFFS INWRD NOGAP ASCGAP ASCGA1 ASCGA4 ASCGA2 ASCGA3 ASCCHR USETCK
;TRANS1 -- FIGURE OUT WHAT TO DO
;This guy dispatches to the right routine for the transfer.
;If any failure occurs no you popj past the listing routine.
TRANS1: TRNE TSWTCH,RE
TLNN DEVCHR,DIRDEV
JRST TRANS4
PUSHJ P,REENTR ;we're doing a rename.
POP P,(P) ;lose return go up extra level.
POPJ P, ;return.
TRANS4: PUSHJ P,ENTERO ;standard enter.
JRST PPOPJ1
MOVEI BRK,13
TLNE OUTCHR,TTYDEV
TRNN TSWTCH,L
CAIA
XCT ALTDEV
IFN SENDSW,<TLNE TSWTCH,SNDSWT
TLNN DEVCHR,TTYDEV
JRST TRAN5
SKIPN MESFLG ;ARE WE DOING THE ∂ THING?
JRST TRAN6 ;NO
MOVEI BRK,15
PUSHJ P,SNDCHR
MOVEI BRK,12
MOVEM BRK,C.LAST
PUSHJ P,SNDCHR
MOVEI BRK,"∂"
PUSHJ P,SNDCHR
PUSHJ P,PDT ;∂DATE, TIME AND PPN
TRAN6: TTYUUO 3,[ASCIZ/Type message followed by /]
SETO T,
TTYUUO 6,T
TLNN T,420000 ;III OR DATA RISK?
SKIPA T,[[ASCIZ/<CTRL>Z:
/]]
MOVEI T,[ASCIZ/<CTRL><META><LF>:
/]
TTYUUO 3,(T)
TRAN5: >;SENDSW
TRNE TSWTCH,TT
PUSHJ P,TITLPG ;title page only when asked for and if there is something to print.
PUSHJ P,LPTENT ;FIX UP HEADER.
TRNE TSWTCH,FRT
TLO TSWTCH,LF ;MAKE CONTROL HAPPEN ON FIRST CHAR.
TRNE TSWTCH,DU ;/DUMPED?
JRST DMPMOD ;YES, SPECIAL ROUTINE
TRNN TSWTCH,IMAGE ;ASCII OR IMAGE TRANSFER?
JRST ASCGAP ;DEFINITELY ASCII
IFN STANSW,<
TLNE OUTCHR,DSKDEV ;ONLY TO AND
TLNN DEVCHR,DSKDEV ;FROM DISK
JRST NOOFFS
MOVE T,SETOFF
CAIN T,1 ;ALREADY IS THIS, AVOID UUO
JRST NOOFFS
MTAPE FO,WRTOFF
CAIA
JRST NOOFFS
PUSHJ P,[RECMES(<MTAPE to set file offset failed, >,IDEV+1,SOURCE,Type Y to go on.,-1)]
JRST QUIT
NOOFFS:
>;STANSW
TRNN TSWTCH,BLK
TLNE PRO,BIN ;FORCING TRANSFER?
JRST NOGAP ;YES
JRST STOPGA
INWRD: ILDB BRK,IFIL+1 ;get a byte of data.
PUSHJ P,SNDCHR ;output BRK.
NOGAP: SOSLE IFIL+2 ;check for input data.
JRST INWRD
PUSHJ P,INHIM ;no get more.
TRNN TSWTCH,BLK ;record blocking?
JRST INWRD ;no, go on.
PUSHJ P,OUTHIM ;kut0up t/ keep blocks even.
AOS OFIL+2 ;add one to output word count.
JRST INWRD ;go on.
ASCGAP:
IFN STANSW,<PUSHJ P,USETCK>
MOVEI BRK,14
SKIPN GOPAGE ;WILL THIS BE THE FIRST CHAR OF A RANGE?
CAMN BRK,LASTOUT ;WAS LAST CHAR NOT A FF?
JRST .+2 ;NO (IT WAS A FF)
PUSHJ P,HDCHK ;SNEAK IN HERE TO JUSTIFY THINGS CORRECTLY
TRNE TSWTCH,N ;UN-NUMBERING?
JRST ASCGA2 ;YES
PUSHJ P,RCVCHR ;GET ONE CHAR
TLNN OUTCHR,DSKDEV!UDEV!PTPDEV!DTADEV!MTADEV
JRST ASCGA4 ;NO TEST IF NOT ONE OF THESE
MOVE WRD,@IFIL+1 ;GET FIRST WORD
TRNE WRD,1 ;LINE NUMBER?
PUSHJ P,[RECMES(<This file has line numbers, >,IDEV+1,SOURCE,<Type Y to delete them, else they
will become part of the text.>,-1)]
JRST ASCGA4 ;WANTS THEM AS PART OF TEXT, ENTER LOOP (WITH FIRST BYTE)
JRST ASCGA3 ;DO /N, ALREADY GOT FIRST WORD (IS LINE NUMBER)
ASCGA1: PUSHJ P,RCVCHR ;GET HERE IF ASCII TRANSFER
ASCGA4: PUSHJ P,PUTCHD
JRST ASCGA1 ;SEE HOW SIMPLE
ASCGA2: PUSHJ P,RCVCHR
MOVE WRD,@IFIL+1 ;GET FULL WORD
TRNE WRD,1 ;LINE NUMBER OR PAGE MARK?
JRST ASCGA3
PUSHJ P,PUTCHD
JRST ASCGA2
ASCGA3: PUSHJ P,RCVCHR ;SKIP A CHAR OF NEXT WORD
MOVE WRD,@IFIL+1 ;AVOID CERTAIN KINDS OF LOSSAGE
TRNE WRD,1
JRST ASCGA3 ;LOOP UNTIL YOU'VE EATEN ONE NON LINE NUMBER CHAR
JRST ASCGA2
ASCCHR: PUSHJ P,RCVCHR
AOS (P)
POPJ P,
IFN STANSW,<
USETCK: TLNE DEVCHR,DSKDEV ;DISK AND
TLNE PRO,ALL ;ALL OF THE FILE?
POPJ P,
MOVEI T,1
MOVEM T,USETP ;NO, ONLY GIVE HIM THIS MUCH
USETI FI,1
POPJ P,
>;STANSW
;ENTERO REENTR
;ENTERO -- SETUP FILENAME
;this is the routine that does enters and renames when they are needed.
;if he is successful he does a skip return otherwise he does not.
ENTERO: TLNE TSWTCH,FIRST ;this is the standard enter routine.
JUMPL TSWTCH,SPOPJ1
MOVEI LINLEN
MOVEM LCHCNT ;ONLY TIME WE KNOW WE ARE AT THE TOP OF A
SETZM LINCNT ;PAGE, BUT WE DIDN'T PUT OURSELVES THERE
SETZM NSPACE ;NO SPACES TO END OF LINE YET
MOVEI 14
MOVEM LASTOUT ;SET LAST CHAR PUT OUT TO FF SO FIRST ONE GOES AWAY
TLNN PRO,H ;/HEADER?
TLZA TSWTCH,HDR ;NO, CLEAR THIS BIT, IT WON'T BE KEPT HONEST
TLO TSWTCH,HDR ;SET HEADER NEEDED
REENTR: MOVE DESTIN+2
TLNE OUTCHR,MTADEV
TRNN SAV
TLNE OUTCHR,DIRDEV ;don't do enter for non-directory device.
CAIA
JRST SPOPJ1
MOVE DESTIN+4 ;PICK UP A FLAG WORD
TRNE NAMSTR
SKIPA WRD,SOURCE
MOVE WRD,DESTIN ;get file name.
MOVEM WRD,OBUF ;put filename in obuf.
TRNE EXTSTR
SKIPA WRD,SOURCE+1
MOVE WRD,DESTIN+1
HLLZM WRD,OBUF+1 ;put away.
TLNN TSWTCH,DELSWT ;always use source for delete
TRNE PNSTR
SKIPA WRD,SOURCE+3 ;yes, use source.
MOVE WRD,DESTIN+3
HRRM WRD,OBUF+3 ;put away.
TLNN TSWTCH,DELSWT
TRNE PSTR
SKIPA WRD,SOURCE+3 ;yes, use source.
MOVE WRD,DESTIN+3
HLLM WRD,OBUF+3 ;put away.
MOVE WRD,OBUF+3 ;get PPN.
MOVEM WRD,PPNTMP ;save them.
HLLZS T,OBUF+1 ;zero right half of obuf+1 and get left half into t.
SETZM OBUF+2 ;zero obuf+2.
MOVE DESTIN+2
TRNE SAV ;/SAVE?
TLNN OUTCHR,MTADEV ;and magtape
JRST ENTER1
MOVNI 1 ;yes, then write 4 words of directory info
MOVE BRK,ODEV
TRNN BRK,10
MOVNI 5
ADDM OFIL+2
SKIPG OFIL+2
PUSHJ P,OUTHIM
MOVE BRK,OBUF
AOS OFIL+1
MOVEM BRK,@OFIL+1 ;filename
MOVE BRK,OBUF+1
AOS OFIL+1
MOVEM BRK,@OFIL+1 ;extension
LDB BRK,[POINT 3,SOURCE+1,20]
DPB BRK,[POINT 3,@OFIL+1,20]
MOVE BRK,SOURCE+2 ;use input date
AOS OFIL+1
MOVEM BRK,@OFIL+1 ;date
MOVE BRK,OBUF+3
AOS OFIL+1
MOVEM BRK,@OFIL+1
MOVNI 3
MOVE BRK,ODEV
TRNN BRK,10
MOVNI =19
ADDM OFIL+2
JRST SPOPJ1 ;that's all
;ENTER1 MAKEIT ENTER2
; CHECK EXISTS
ENTER1: TRNN TSWTCH,Q ;/QUIET?
TRNE TSWTCH,RE ;or /RENAME?
JRST MAKEIT ;then take five giant steps.
IFN UDPSW,<TLNE OUTCHR,UDEV
ULOOK FO,OBUF >;UDPSW
LOOKUP FO,OBUF ;lookup output file.
JRST [ HRRZ T,OBUF+1 ;error return.
JUMPE T,MAKEIT ;none existed, fine.
PUSHJ P,MESS22 ;some other reason, tell why.
PUSHJ P,[RECMES(Safety LOOKUP of ,ODEV+1,OBUF,<Type Y to try to ENTER it.>,-1)]
POPJ P,
JRST MAKEIT]
MOVE WRD,PPNTMP ;get PPN.
MOVEM WRD,OBUF+3 ;put away.
HLLZ T2,OBUF+1 ;get ext. from lookup block.
CAMN T,T2 ;has it changed?
PUSHJ P,[MESS4:RECMES(<File already exists, >,ODEV+1,OBUF,Type Y to replace.,-1)]
POPJ P,
MOVEM T,OBUF+1 ;put right one back.
MAKEIT: MOVEM PRO,OBUF+2 ;set default protection.
HLLZS OBUF+1 ;FLUSH DATE CREATED
MOVSI 777000
ANDM OBUF+2 ;AND CLEAR ALL ELSE
AND SOURCE+2
TLNN PRO,PP ;check protection switch.
TLNN DEVCHR,DSKDEV!UDEV ;disk?
CAIA ;no to either one.
MOVEM OBUF+2
IFN 0,< MOVE SOURCE+2 ;SUPPRESS COPYING OF DATE LAST WRITTEN
TLZ 777000
IORM OBUF+2 ;COPY DATE
LDB [POINT 3,SOURCE+1,20]
DPB [POINT 3,OBUF+1,20]
>;IFN 0
IFN STANSW,<SETZM OBUF+4 ;CLEAR THESE FOR SURE
SETZM OBUF+5 ; "
>;STANSW
CLOSE FO,0 ;close
TRNE TSWTCH,RE ;/RENAME?
JRST RENAM1
IFG OLD,<TLNN OUTCHR,DSKDEV ; FOR NUL: DEVICE
TLNN OUTCHR,DTADEV
JRST ENTER2
MOVE SAVK ;here we see if file wil fit on dectape.
UGETF FO,T
MOVN T,T
ADDI T,=577
IMULI T,177
CAML T,0
JRST ENTER2
PUSHJ P,[RECMES(File may not fit ,ODEV+1,OBUF,Type Y to try it.,-1)]
POPJ P,
ENTER2:>;OLD
;ENTERG ENTER3 ENTERF RENAM1 NODPAS GOREN REALMS COUNTD
; ENTER, RENAME
ENTERG:
IFN UDPSW,<TLNE OUTCHR,UDEV
UENTER FO,OBUF >;UDPSW
ENTER FO,OBUF ;create file.
CAIA
JRST [ MOVE T,PPNTMP
MOVEM T,OBUF+3
JRST SPOPJ1]
TLNN OUTCHR,DTADEV ;dectape?
JRST ENTER3
SIXOUT IDEV+1
TTYUUO 1,[":"]
SIXOUT SOURCE
HLLZ SOURCE+1
SKIPE 0 ;NO EXT, NO PERIOD
TTYUUO 1,["."]
SIXOUT 0
TTYUUO 3,[ASCIZ/, is input file.
/]
ERRMES(<DECtape directory is full>)
ENTER3: HRRZ T,OBUF+1 ;error retrun.
PUSHJ P,MESS22 ;give reason.
CAIN T,12 ;DISK FULL?
JRST ENTERF
PUSHJ P,[RECMES(<ENTER on >,ODEV+1,OBUF,<Type Y to go on.>)]
JRST QUIT
POPJ P,
ENTERF: SETO
GETLIN ;GET LINE CHARACTERISTICS
CAMN [-1] ;DETACHED?
JRST [ MOVEI 1 ;YES
CALLI 31 ;SLEEP A SECOND
JRST ENTERG] ;AND TRY AGAIN
PUSHJ P,[RECMES(<ENTER on >,ODEV+1,OBUF,<Type Y to try again.>)]
POPJ P,
JRST ENTERG
RENAM1:
IFN PASSSW,<
TLNN DEVCHR,DSKDEV
JRST NODPAS
MOVE WRD,SOURCE+3 ;CHECK SOURCE PPN
MOVE T,IDEV+1
PUSHJ P,PASCHK
POPJ P,
NODPAS:
>;PASSSW
IFN DPROSW,<
MOVE SOURCE+2
TLNE 200000 ;is file delete protected?
TLNN TSWTCH,DELSWT ;and are we deleting
JRST GOREN ;no, go on
TLNE DEVCHR,DSKDEV!UDEV ;on disk?
TRNE TSWTCH,Q ;and not suppressing
CAIA
JRST [ PUSHJ P,[RECMES(DELETE protected:,IDEV+1,SOURCE,Type Y to DELETE.,-1)]
POPJ P,
JRST GOREN]
GOREN:
>;DPROSW
IFN UDPSW,<TLNE DEVCHR,UDEV
URENAM FI,OBUF>
RENAME FI,OBUF ;try the rename.
CAIA
JRST COUNTD ;we win, return.
HRRZ OBUF+1 ;lose get reason.
CAIE 4 ;is it filename already exists.
JRST REALMS ;no give real reason.
TRNN TSWTCH,Q ;should we wake him up.
JRST [ PUSHJ P,MESS4 ;yes.
POPJ P,
JRST .+1]
MOVE OBUF+2 ;SAVE PROTECTION AND DATE WORD
IFN UDPSW,<TLNE OUTCHR,UDEV
ULOOK FO,OBUF >;UDPSW
LOOKUP FO,OBUF ;find output name.
JFCL ;WILL LOSE ON NEXT RENAME IF LOSES HERE
MOVEM OBUF+2 ;RESTORE PROTECTION AND DATE FOR RENAME
HLLZS OBUF+1 ;CLEAR CREATION DATE
MOVE PPNTMP ;reset ppn.
MOVEM NULL+3 ;to null block.
MOVEM OBUF+3 ;AND NEW NAME BLOCK
IFN UDPSW,<TLNE OUTCHR,UDEV
URENAM FO,NULL >;UDPSW
RENAME FO,NULL ;delete.
JFCL
SETZM NULL+1
SETZM NULL+3 ;fix null.
MOVE SOURCE+3
MOVEM PPNTMP
IFN UDPSW,<TLNE DEVCHR,UDEV
ULOOK FI,SOURCE >;UDPSW
LOOKUP FI,SOURCE ;get old guy again.
JFCL
MOVE PPNTMP
MOVEM SOURCE+3 ;reset ppn.
IFN UDPSW,<TLNE DEVCHR,UDEV
URENAM FI,OBUF >;UDPSW
RENAME FI,OBUF ;this time for sure.
CAIA
JRST COUNTD
REALMS: HRRZ T,OBUF+1 ;oops!
PUSHJ P,MESS22
PUSHJ P,[RECMES(RENAME of ,IDEV+1,SOURCE,Type Y to go on.)]
JRST QUIT
POPJ P,
COUNTD: AOS (P)
TLNN TSWTCH,DELSWT
POPJ P,
MOVE T,SAVK
JRST COUNTK
;STOPGA OPT0 OPT1 OPT2
;STOPGA
;This routine optimizes stopgap type files such that the last
;word of a record will never have the low order bit on.
;or send you to the crunching routine if you are deleteing sequence numbers.
STOPGA: TRNE TSWTCH,O ;should we check format.
JRST OPT0 ;no.
MOVE T,ODEV+1 ;OUTPUT DEVICE NAME
CALL T,['BUFLEN'] ;GET BUFFER SIZE
MOVE T2,IDEV+1 ;INPUT DEVICE NAME
CALL T2,['BUFLEN']
CAME T,T2 ;DIFFERENT SIZE?
PUSHJ P,STPCHK ;NO, CHECK IF STOPGAP FORMAT FILE
JRST NOGAP ;NOT STOPGAP, OR NOT NECESSARY
OPT0: TLNN TSWTCH,FIRST ;first file.
JRST OPT1
JUMPGE TSWTCH,OPT1
MOVE T,IFIL+1 ;no, get byte pointer if plsmod.
MOVE T,1(T) ;get first word in buffer.
TRNN T,1 ;bit 35 on?
JRST OPT1 ;no skip.
MOVE BRK,[ASCID/ /] ;make a word to preceed ff.
PUSHJ P,SNDCHR
MOVE BRK,[15B6+15B13+14B20] ;make a ff word.
PUSHJ P,SNDCHR
OPT1: SOSG IFIL+2
PUSHJ P,INHIM
ILDB BRK,IFIL+1
JUMPE BRK,OPT1 ;skip zeroes.
SOSG T,OFIL+2 ;output full.
PUSHJ P,OUTHIM ;yes.
TRNN BRK,1 ;line number?
JRST OPT2
CAIE T,1 ;yes, is there room for him.
JRST OPT2 ;yes.
SETZ T, ;no
IDPB T,OFIL+1 ;write zero word.
PUSHJ P,OUTHIM ;do output
OPT2: IDPB BRK,OFIL+1
JRST OPT1
;STPCHK STP1 STP3 STP2 STP4 CRSTP FINWRD ENDBUF
;STPCHK
;This concieted bastard thinks he can tell the difference between a stopgap file and anything else.!!!!!!!!!
;If he thinks it is a stopgap file he turns on the STOP bit in tswtch
;otherwise he turns it off.
STPCHK: MOVEI T,1 ;make bit 35 mask.
SOSG IFIL+2 ;check input data.
PUSHJ P,INHIM ;get more.
AOS T3,IFIL+2 ;add one to ifil+2 and put into both t3 and ifil+2.
HRRZ BRK,IFIL ;get pointer to current buffer.
ADDI T3,(BRK) ;add it to word count.
MOVSI T2,<POINT 7,0>⊗-22
ADDI T2,2(BRK) ;first word of buffer.
TLNE DEVCHR,MTADEV
TRNN TSWTCH,SAV
CAIA
ADDI T2,4 ;fix word count for /SAVE
ILDB WRD,T2 ;get a word.
STP1: CAIGE T3,(T2) ;check if at end.
JRST SPOPJ1 ;END AND OK
SKIPN (T2) ;zero word in buffer?
JRST ENDBUF ;yes.
TDNN T,(T2) ;bit 35 on?
POPJ P, ;no, lose.
MOVE BRK,[ASCID/ /] ;make word that preceeds ff.
CAME BRK,(T2) ;is that it?
JRST [ MOVEI BRK,(T2)
JRST STP3]
AOJ T2, ;yes, next word.
MOVE BRK,[BYTE (7)15,15,14,0,0] ;make ff word.
CAME BRK,(T2) ;is that it.
POPJ P, ;no not stopgap.
AOJ T2, ;inc. t2.
LDB WRD,T2 ;get first byte.
JRST STP1 ;process it.
STP3: CAIL WRD,60 ;must be
CAIL WRD,72 ;a number.
POPJ P, ;nope, no stopgap.
ILDB WRD,T2 ;yes, get next char.
CAIN BRK,(T2) ;are we in next word.
JRST STP3 ;no.
CAIE WRD,11 ;yes, it better be a tab.
POPJ P, ;nope.
STP2: CAIGE T3,(T2) ;at end of buffer.
JRST SPOPJ1 ;WIN!
TDNE T,(T2) ;bit 35 on?
POPJ P, ;yes, lose.
MOVEI BRK,(T2) ;pointer to current word.
STP4: CAIN WRD,15 ;<cr>?
JRST CRSTP ;yes.
ILDB WRD,T2 ;next char.
CAIN BRK,(T2) ;are we in next word.
JRST STP4 ;no.
JRST STP2 ;yes.
CRSTP: ILDB WRD,T2 ;<cr> must be followed by
CAIGE T3,(T2)
JRST SPOPJ1 ;END OF BUFFER, WE WIN.
CAIE WRD,12 ;<lf>.
POPJ P, ;no, lose?
MOVEI BRK,(T2) ;pointer to current word.
ILDB WRD,T2 ;get a char.
CAIE BRK,(T2) ;are we in next word.
JRST STP1
FINWRD: JUMPN WRD,STP2 ;yes, if non-zero char. go to stp2.
ILDB WRD,T2 ;get next char.
CAIE BRK,(T2) ;are we in next word.
JRST [ CAIN T3,-1(T2) ;was that last word.
JRST SPOPJ1 ;get out now.
JRST STP1] ;go ahead.
JUMPE WRD,FINWRD+1 ;zero word? get next.
POPJ P, ;lose.
ENDBUF: SKIPE (T2) ;found zero word in buffer.
POPJ P, ;lose if this one isn't.
CAILE T3,(T2) ;are we at end of buffer.
AOJA T2,ENDBUF ;no
JRST SPOPJ1 ;FINISHED WITH ZEROES.
;DMPMOD LINE1 LINE2 LINEON REDMP WRCHK WRCHK1 WRCHK2 INDMP NXTDMP WRDNUM NXTNUM NOSLOP
;DMPMOD
;This clever little routine is for the /DUMPED switch.
;It outputs 36 bit words in octal.
;preceeding each line with the core location of the first word of that line.
DMPMOD:
IFN STANSW,<PUSHJ P,USETCK>
SETZM T2 ;word count.
MOVEI T3,7
MOVE WRD,[POINT 7,[ASCIZ/ 0 1 2 3 /
ASCIZ/ 4 5 6 7/]]
LINE1: ILDB BRK,WRD
PUSHJ P,%HDCHK
JUMPN BRK,LINE1
TLNN OUTCHR,TTYDEV
JRST LINE2
MOVEI BRK,15
PUSHJ P,%HDCHK
MOVEI BRK,12
PUSHJ P,%HDCHK
MOVEI T3,3
LINE2: ILDB BRK,WRD
PUSHJ P,%HDCHK
JUMPN BRK,LINE2
LINEON: MOVEI BRK,15
PUSHJ P,%HDCHK
MOVEI BRK,12
PUSHJ P,%HDCHK
REDMP: SOSG IFIL+2 ;data?
PUSHJ P,INHIM ;get more.
ILDB WRD,IFIL+1
WRCHK: SKIPN DISP,GOPAGE ;WORDING?
JRST WRCHK2 ;NO
TRNE DISP,-1 ;IN RANGE YET?
JRST WRCHK1 ;NO
HLRZ DISP,DISP
CAML DISP,T2 ;PAST LAST WORD YET?
JRST WRCHK2 ;NO, PUT OUT WORD
ILDB DISP,STK ;GET NEXT TERM
MOVEM DISP,GOPAGE ;STORE IT
JUMPE DISP,EOF ;END?
HLLI DISP,
TLNE DEVCHR,DSKDEV ;DISK ONLY
CAML DISP,T2
JRST WRCHK ;CHECK AGAIN
IFE STANSW,<USETI FI,1 ;BACK TO FRONT OF FILE>
IFN STANSW,<USETI FI,@USETP>
SETZ T2, ;BACK TO WORD 0
JRST REDMP
WRCHK1: HLLI DISP,
CAMLE DISP,T2 ;GOT TO BEG. YET?
AOJA T2,REDMP ;NO
HLLZS DISP,GOPAGE ;FLAG IN RANGE
JRST WRDNUM ;DO WORD NUMBER
WRCHK2: TDNN T2,T3 ;multiple of 8 (OR 4 ON TTY).
JRST WRDNUM
INDMP: MOVEI BRK," "
PUSHJ P,%HDCHK
PUSHJ P,%HDCHK
MOVEI T,14 ;number of numbers to output.
NXTDMP: SETZM BRK
LSHC BRK,3 ;get a number.
ADDI BRK,60 ;make it a char.
PUSHJ P,%HDCHK
SOJG T,NXTDMP ;are we done?
AOJA T2,REDMP ;INC WORD COUNT AND GET A WORD
WRDNUM: MOVEI BRK,15 ;<cr>
PUSHJ P,%HDCHK
MOVEI BRK,12 ;<lf>.
PUSHJ P,%HDCHK
MOVEI T,6 ;six num's.
MOVE WRD,T2 ;get word count.
TDZ WRD,T3 ;make it first of line
LSH WRD,22 ;put to left of WRD.
NXTNUM: SETZM BRK
LSHC BRK,3 ;get a num.
ADDI BRK,60 ;make it a char.
PUSHJ P,%HDCHK
SOJG T,NXTNUM ;are we done?
MOVEI BRK,"/"
PUSHJ P,%HDCHK
MOVE T4,T3
AND T4,T2 ;GET SLOP!
JUMPE T4,NOSLOP
IMULI T4,=14 ;INVENT MISSING WORDS!
MOVEI BRK," "
PUSHJ P,%HDCHK
SOJG T4,.-1
NOSLOP: LDB WRD,IFIL+1
JRST INDMP ;proceed.
;TITLPG TITLP1 TIT10 NODIRT GOPART CLINE MLINE NODIRX SPCRLF
;TITLPG
;this guy puts out a title page at the beginning of your output.
;be careful he twiddles the byte pointers for the output buffer.
TITLPG: PUSHJ P,TITLP1 ;make two copies for dear old whit.
TITLP1: MOVE ODEV
TRNN 10
JRST TIT10
MOVSI <POINT 7,0,34>⊗-22;fix pointers if data mode≠0.
HRR OFIL+1
MOVEM PNTR
SOS T,OFIL+2
IMULI T,5
AOJ T,
MOVEM T,CNTR
TIT10: MOVE DISP,[IDPB BRK,NULL+3];byte pointer in null+3
EXCH DISP,ALTDEV ;does an xct altdev
MOVE [POINT 7,NULL] ;compile string in null
MOVEM NULL+3
TLNN DEVCHR,DIRDEV
JRST NODIRX
SIXSTR SOURCE ;first filename
PUSHJ P,TLINE ;put it out
HLLZ T2,SOURCE+1
SIXSTR T2 ;then ext if any
PUSHJ P,TLINE ;put it out
PPNSTR SOURCE+3 ;ppn
PUSHJ P,TLINE ;print it
PUSHJ P,TIMOU2 ;time
PUSHJ P,TLINE ;print
LDB T,[POINT 12,SOURCE+2,35]
LDB T2,[POINT 3,SOURCE+1,20];DATE75
DPB T2,[POINT 3,T,23]
NODIRT: IDIVI T,=31
AOJ T2,
IDIVI T2,12
MOVEI BRK,60(T2)
IDPB BRK,NULL+3
MOVEI BRK,60(T3)
IDPB BRK,NULL+3
IDIVI T,=12
SEVSTR DATES(T2)
ADDI T,=64
IDIVI T,12
MOVEI BRK,60(T)
IDPB BRK,NULL+3
MOVEI BRK,60(T2)
IDPB BRK,NULL+3
MOVEM DISP,ALTDEV ;put back altdev
PUSHJ P,TLINE ;print date
SETZM NULL ;clear him
SETZM NULL+1
SETZM NULL+2
SETZM NULL+3
IFE DECSW,< MOVEI T,PGLEN-=50+3>
IFN DECSW,< MOVEI T,PGLEN-=50>
GOPART: PUSHJ P,SPCRLF ;SEND THIS SO LPT WON'T FUCK UP!
SOJG T,GOPART
PUSH P,[3] ;3 LINES OF THIS CRUFT
CLINE: PUSHJ P,SPCRLF ; 15,177,21
MOVEI T,LINLEN/2 ;SEND A LINE OF *|'S
MLINE: MOVEI BRK,"*"
PUSHJ P,PUTCHR
MOVEI BRK,"|"
PUSHJ P,PUTCHR
SOJG T,MLINE
SOSLE (P)
JRST CLINE
POP P,(P)
MOVEI BRK,15
PUSHJ P,PUTCHR
MOVEI BRK,14 ;next page please
PUSHJ P,PUTCHR
MOVE ODEV
TRNN 10 ;do we have to fix pointers
POPJ P, ;no, we're done.
MOVE PNTR
HRRM OFIL+1 ;fix output buffer header.
SOS T,CNTR
IDIVI T,5
AOJ T,
MOVEM T,OFIL+2 ;and count.
POPJ P, ;all done.
NODIRX: SIXSTR IDEV+1 ;PRINT DEVICE NAME INSTEAD
MOVEI T,":"
IDPB T,NULL+3
PUSHJ P,TLINE ;PRINT IT BIG
MOVEI BRK,12 ;NOW SOME LF'S
MOVEI T,=20 ;EQUIVALENT TO 2 BIG LINES
PUSHJ P,PUTCHR
SOJG T,.-1
CALLI T,23
IDIVI T,=1000*=60 ;GET MINUTES
PUSHJ P,TIMOUT
PUSHJ P,TLINE
CALLI T,14 ;NOW DATE
JRST NODIRT ;THEN TIME AND DATE
SPCRLF: MOVEI BRK,15
PUSHJ P,PUTCHR
IFE DECSW,< MOVEI BRK,177
PUSHJ P,PUTCHR
MOVEI BRK,21
>;DECSW
IFN DECSW,< MOVEI BRK,23 >
JRST PUTCHR
;TLINE TLINE1 TLINE2 TLINE3 DECODE DECOD1
;TLINE, DECODE
TLINE: MOVEI 0
IDPB NULL+3 ;put null at end of string
MOVE T,[POINT 7,CHRTBL(WRD),6];byte pointer to large char bits
MOVEI T3,12 ;=10 vert bytes
TLINE1: MOVE T2,[POINT 7,NULL] ;point to beginning of string
MOVEM T2,NULL+3 ;and reset for next time
TLINE2: ILDB WRD,T2 ;get a char.
JUMPE WRD,TLINE3 ;end if null
CAIL WRD,140
TRZ WRD,40 ;UPPERCASEIFY
MOVEM WRD,STAR ;use this char in printout
SUBI WRD,40 ;table uses sixbit
IMULI WRD,2 ;two words per char
LDB WRD,T ;get byte of bits. he he!
PUSHJ P,DECODE ;put out one line for this char
JRST TLINE2 ;next in string
TLINE3: MOVEI BRK,15 ;return
PUSHJ P,PUTCHR
MOVEI BRK,12 ;lf
PUSHJ P,PUTCHR
IBP T ;next bit byte
SOJG T3,TLINE1 ;and loop
POPJ P, ;all done
;this routine puts out seven chars. one for each of the rightmost 7 bits
;in WRD if the bit is on it puts out the char. in STAR otherwise a space.
DECODE: PUSH P,BRK ;save t.
TLO WRD,777400 ;10 chars
DECOD1: TRNE WRD,1⊗=9 ;3 will be spaces
SKIPA BRK,STAR ;non-zero use char in star.
MOVEI BRK," " ;zero use space.
PUSHJ P,PUTCHR ;put it.
LSH WRD,1
JUMPL WRD,DECOD1
POP P,BRK
POPJ P, ;return.
;CHRTBL
;TITLPG CHAR TABLE
;this is a table which has ten 7 bit bytes for all legal sixbit chars.
;a 1 means put a char in this position 0 means don't.
DEFINE CHR10(A,B,C,D,E,F,G,H,I,J)
<
BYTE(7)A,B,C,D,E
BYTE(7)F,G,H,I,J
>
CHRTBL: 0 ;SPACE
0
CHR10 34,34,34,34,34,34,34,0,34,34 ;!
CHR10 24,24,0,0,0,0,0,0,0,0 ;"
CHR10 24,24,177,24,24,177,24,24,0,0 ;#
CHR10 24,76,125,124,76,25,125,76,24,0 ;$
CHR10 177,121,142,4,10,20,43,105,107,0 ;%
CHR10 10,24,24,10,25,42,42,35,0,0 ;&
CHR10 10,20,0,0,0,0,0,0,0,0 ;'
CHR10 4,10,20,20,20,20,20,10,4,0 ;(
CHR10 20,10,4,4,4,4,4,10,20,0 ;)
CHR10 0,0,42,24,177,24,42,0,0,0 ;*
CHR10 0,0,10,10,177,10,10,0,0,0 ;+
CHR10 0,0,0,0,0,0,0,10,10,20 ;,
CHR10 0,0,0,0,177,0,0,0,0,0 ;-
CHR10 0,0,0,0,0,0,10,34,10,0 ;.
CHR10 0,1,2,4,10,20,40,100,0,0 ;/
CHR10 0,34,42,105,111,121,42,34,0,0 ;0
CHR10 0,10,30,10,10,10,10,177,0,0 ;1
CHR10 0,76,101,1,36,40,100,177,0,0 ;2
CHR10 0,177,2,4,16,1,101,76,0,0 ;3
CHR10 0,4,14,24,44,177,4,4,0,0 ;4
CHR10 0,177,100,100,176,1,101,76,0,0 ;5
CHR10 0,76,101,100,176,101,101,76,0,0 ;6
CHR10 0,177,1,2,4,10,10,10,0,0 ;7
CHR10 0,76,101,101,76,101,101,76,0,0 ;8
CHR10 0,76,101,101,77,1,101,76,0,0 ;9
CHR10 0,0,30,30,0,0,30,30,0,0 ;:
CHR10 0, 0,30,30,0,0,30,30,10,20 ;;
CHR10 0,0,4,10,20,10,4,0,0,0 ;LEFT BROKET
CHR10 0,0,0,177,0,177,0,0,0,0 ;=
CHR10 0,0,20,10,4,10,20,0,0,0 ;RIGHT BROKET
CHR10 0,76,101,1,2,4,10,10,0,10 ;?
CHR10 0,76,101,101,135,125,137,100,100,76 ;@
CHR10 0,76,101,101,101,177,101,101,0,0 ;A
CHR10 0,176,101,101,176,101,101,176,0,0 ;B
CHR10 0,76,101,100,100,100,101,76,0,0 ;C
CHR10 0,174,102,101,101,101,102,174,0,0 ;D
CHR10 0,177,100,100,170,100,100,177,0,0 ;E
CHR10 0,177,100,100,174,100,100,100,0,0 ;F
CHR10 0,76,101,100,100,107,101,76,0,0 ;G
CHR10 0,101,101,101,177,101,101,101,0,0 ;H
CHR10 0,177,10,10,10,10,10,177,0,0 ;I
CHR10 0,177,10,10,10,10,110,60,0,0 ;J
CHR10 0,101,102,104,170,104,102,101,0,0 ;K
CHR10 0,100,100,100,100,100,100,177,0,0 ;L
CHR10 0,101,143,125,111,101,101,101,0,0 ;M
CHR10 0,101,141,121,111,105,103,101,0,0 ;N
CHR10 0,76,101,101,101,101,101,76,0,0 ;O
CHR10 0,176,101,101,176,100,100,100,0,0 ;P
CHR10 0,76,101,101,101,111,105,76,2,1 ;Q
CHR10 0,176,101,101,176,104,102,101,0,0 ;R
CHR10 0,76,101,100,76,1,101,76,0,0 ;S
CHR10 0,177,10,10,10,10,10,10,0,0 ;T
CHR10 0,101,101,101,101,101,101,76,0,0 ;U
CHR10 0,101,101,42,42,24,24,10,0,0 ;V
CHR10 0,111,111,111,111,111,52,24,0,0 ;W
CHR10 0,101,42,24,10,24,42,101,0,0 ;X
CHR10 0,101,42,24,10,10,10,10,0,0 ;Y
CHR10 0,177,2,4,10,20,40,177,0,0 ;Z
CHR10 0,34,20,20,20,20,20,34,0,0 ;[
CHR10 0,100,40,20,10,4,2,1,0,0 ;\
CHR10 0,34,4,4,4,4,4,34,0,0 ;]
CHR10 0,10,34,52,10,10,10,10,0,0 ;↑
CHR10 0,0,20,40,177,40,20,0,0,0 ;←
;SIXST1 SIXOU1 SIXCHR SEVST1 GETBYT PPNST1 PPNOU1 SIXJST OCTOUT POKE POK1 R10TTY RADX10 R10OUT
;OUTPUT SUBRS -- SIX, SEV, PPN, DEC, OCT, POKE
;This is a sixbit word outputer?
;calling sequence
;MOVE WRD,[<sixbit word>]
;PUSHJ P, SIXOU1 to tty or SIXST1 to list device
;
;or
;SIXOUT [<sixbit word>] ;to tty
;SIXSTR [<sixbit word>] ;to list device
SIXST1: SKIPA ALT,ALTDEV ;start here for output to listing device.
SIXOU1: MOVE ALT,[TTYUUO 1,BRK] ; " " " " " tty.
SIXCHR: JUMPE WRD,CPOPJ ;quit on 0
SETZ BRK,
LSHC BRK,6 ;get a char
ADDI BRK,40 ;make it ascii
XCT ALT ;output it
AOS CHRCNT ;and count it
JRST SIXCHR ;and loop
;ascii output routine... puts out char. using XCT ALTDEV
;MOVEI WRD,<pointer to string> ;to tty
;or
;SEVSTR <pointer to string> ;to list device
SEVST1: HLL WRD,[POINT 7,0] ;listing device start.
GETBYT: ILDB BRK,WRD ;byte a char
JUMPE BRK,CPOPJ ;end on first zero byte.
XCT ALTDEV ;out with it.
JRST GETBYT ;another.
;routine to output project programmer initials
;calling sequence
;MOVE WRD,[PPN]
;PUSHJ P, PPNOU1 to tty or PPNST1 to list device
;or
;PPNSTR [PPN] to list device
;PPNOUT [PPN] to tty
PPNST1: SKIPA ALT,ALTDEV ;listing device start.
PPNOU1: MOVE ALT,[TTYUUO 1,BRK] ;tty start.
SKIPN WRD
DEFPPN WRD,
IFN PPNSW,<
PUSH P,WRD
HRRI WRD,
PUSHJ P,SIXJST
MOVEI BRK,","
XCT ALT
POP P,WRD
HRLZ WRD,WRD
SIXJST: TLNN WRD,770000
LSH WRD,6
TLNN WRD,770000
LSH WRD,6
JRST SIXCHR
>;PPNSW
IFE PPNSW,<HLRZ T,WRD ;for once DEC did something good.
PUSHJ P,OCTOUT
MOVEI BRK,","
XCT ALT
HRRZ T,WRD
OCTOUT: IDIVI T,10
HRLM T2,(P)
SKIPE T
PUSHJ P,OCTOUT
HLRZ BRK,(P)
ADDI BRK,60
XCT ALT
AOS CHRCNT
POPJ P, >;PPNSW
;this is a routine to output a character to the listing device.
;it is called by XCT ALTDEV which either does a ttyuuo or comes here.
;the character should be in brk.
POKE: JUMPE BRK,CPOPJ ;don't do nulls.
SOSG OLST+2 ;room?
POK1: OUT LST, ;no
JRST [ IDPB BRK,OLST+1 ;win.
POPJ P,]
PUSHJ P,[RECMES(List dev. error ,IDEV+1,SOURCE,Type Y to try again.,-1)]
JRST QUIT
JRST POK1
;radix10 output routine... number in T
R10TTY: SKIPA ALT,[TTYUUO 1,BRK] ;to tty
RADX10: MOVE ALT,ALTDEV ;to altdev
R10OUT: IDIVI T,=10 ;one decimal digit into t2
ADDI T2,60 ;ascii
HRLM T2,(P) ;save the bum
SKIPE T ;are we done?
PUSHJ P,R10OUT ;no, recur
HLRZ BRK,(P) ;get back char.
XCT ALT ;put it out
AOS CHRCNT ;COUNT A CHAR PRINTED
POPJ P, ;last popj returns to calling routine
;PUTCHL PUTCHD PUTCON PUTCN2 FF%LF %LFA %LFB %LFC %FF PGCHK PGCHK1 PGCHK2 PGWAT0 PGWAT PGWAT1 PGWAT2 HDCHK0 HDCHK NOTFUL %HDCHK NODISP %CHR %HDR %HDRNOW %CH12 %CH11 %CH13 %CH14 %CH15 %CH21 %CH177
;SINGLE CHAR OUTPUT ROUTINE -- PUTCHL PUTCHD PUTCON %FF PGWAT PGWAT1 PGCHK HDCHK
;this mess is the general purpose single character output routine.
;it does the following wonderful things:
; fortran conversion
; headers
; /EXTRA=
; page lists
; if you are a dpy you get page numbers displayed starting with 2
PUTCHL: CAIN BRK,12 ;SPECIAL ENTRY TO MAKE SURE
TLO BRK,-1 ;LF WON'T GET CONVERTED.
PUTCHD: TLNN OUTCHR,LPTDEV!XGPDEV
JUMPE BRK,CPOPJ ;SKIP ZEROES
TLZN TSWTCH,LF ;CONVERT THIS CHARACTER?
JRST FF%LF ;NO
CAIN BRK,40
JRST [ MOVEI BRK,12 ;SPACE GIVES LF
JRST PUTCN2]
CAIL BRK,"*" ;IN RANGE?
CAIL BRK,"4"
JRST [ HRLM BRK,(P) ;
MOVEI BRK,12 ;PRECEED IT WITH LINE FEED
JRST PUTCON]
MOVE BRK,PCNTAB-<"*">(BRK) ;SAVE SECOND CHAR.
HLLM BRK,(P) ;GET FIRST CHAR.
HRRZS BRK
CAIN BRK,"0"
TLO TSWTCH,LF ;MAKE THIS ONE GET CONVERTED AGAIN
PUTCON: PUSHJ P,PUTCHL ;DO FIRST
HLRZ BRK,(P)
PUTCN2: PUSHJ P,PUTCHL ;DO SECOND ONE
POPJ P, ;WE DID BOTH OF THEM
FF%LF: MOVEI (BRK) ;GET CHAR
CAIE 12
JRST %FF
TRNE TSWTCH,FRT ;LINE FEED, /C?
TLNE BRK,-1 ;YES, CONVERSION SUPPRESSED?
JRST %LFA ;YES.
TLO TSWTCH,LF ;NO, FLAG CONVERSION AND IGNORE
POPJ P,
%LFA:
IFN XGPSW,<
TRNE PRO,ISPACE ;IS /EXTRA REALLY INTERLINE SPACING
JRST PGCHK
>;XGPSW
LDB DISP,[POINT 6,DFTLIN,35]
TLNN TSWTCH,DEL177!HDR ;IS THIS A REAL LF, OR TOP OF PAGE?
SKIPN DISP ;YES, ARE WE EXPANDING LF'S
JRST PGCHK ;NO
CAIN DISP,77 ;IS THIS THE SPECIAL ONE
JRST %LFC ;YES
PUSH P,DISP ;SAVE OF LF'S
%LFB: PUSHJ P,PGCHK ;PUT ONE OUT (GOES THROUGH HDCHK).
TLNN TSWTCH,HDR ;DID THAT PUT US AT TOP OF PAGE.
SOSGE (P) ;NO IS THAT ALL THE LINE FEEDS?
JRST PPOPJ1 ;YES RESTORE STACK AND PROCEED.
JRST %LFB ;DO ANOTHER
%LFC: MOVEI BRK,177 ;SEND A DELETE
PUSHJ P,PUTCHD
MOVEI BRK,21 ;FOLLOWED BY A 21
JRST PUTCHD ;THUS INHIBITING EJECTION AT PAGE BOUNDARY
%FF: CAIE 14
JRST PGCHK
AOS LOGPG ;INC PAGE COUNTER
IFN DISPSW,<PUSHJ P,DPYPG> ;UPDATE PAGE DISPLAY
PGCHK: TLNN OUTCHR,LPTDEV!XGPDEV
JUMPE BRK,CPOPJ ;SKIP IT?
SKIPN DISP,GOPAGE ;ARE WE PAGING?
JRST HDCHK0 ;NO
TRNE DISP,-1 ;ARE WE IN RANGE
JRST PGCHK1 ;NO
HLRZ DISP,DISP ;GET UPPER LIMIT
CAML DISP,LOGPG ;ARE WE THERE
JRST HDCHK ;NO, GO ON
ILDB DISP,STK ;YES, GET NEXT TERM
MOVEM DISP,GOPAGE ;SET IT
JUMPE DISP,EOF ;THAT'S ALL IF 0
HLLI DISP,
TLNE DEVCHR,DSKDEV ;DISK ONLY
CAML DISP,LOGPG ;PAST NEW STARTING POINT?
JRST PGCHK ;OTHERWISE CHECK AGAIN
IFE STANSW,<USETI FI,1 ;BACK TO FRONT>
IFN STANSW,<USETI FI,@USETP>
MOVEI DISP,1
MOVEM DISP,LOGPG
MOVEM DISP,PHYPG
POPJ P,
PGCHK1: HLLI DISP, ;LOOK AT RIGHT HALF
CAMLE DISP,LOGPG ;ARE WE THERE YET
POPJ P, ;NO
HLLZS GOPAGE ;FLAG IT
MOVE DISP,LASTOUT
CAIE BRK,14
JRST [ CAIN DISP,14 ;NO, DO WE HAVE A FF YET?
JRST PGCHK2 ;YES, JUST PRINT THIS ONE
PUSH P,BRK
MOVEI BRK,14
PUSHJ P,HDCHK
POP P,BRK
PGCHK2: PUSHJ P,PGWAT ;SEE IF WE NEED TO WAIT BEFORE NEXT PAGE
JRST HDCHK]
CAIE DISP,14
PGWAT0: PUSHJ P,HDCHK ;PUT OUT THE FF
PGWAT: TLNE OUTCHR,TTYDEV ;ONLY DO THE WAITING IF OUTPUTTING TO TTY
SKIPN PGWAIT ;WANT TO WAIT BEFORE OUTPUTTING NEXT PAGE?
POPJ P, ;NO
CLOSE FO, ;FORCE PREVIOUS STUFF OUT
HRRZS PGWAIT ;NOTE THAT WE'VE WAITED AT LEAST ONCE
PGWAT1: PUSH P,BRK
PGWAT2: INCHWL BRK
ANDI BRK,177
CAIE BRK,12
JRST PGWAT2
POP P,BRK
POPJ P,
HDCHK0: SKIPE GOPAGE
JRST HDCHK ;Paging, so we only stop on new pagelist elements
MOVE DISP,LASTOUT
CAIN DISP,14
PUSHJ P,PGWAT ;We've just begun a new page, so wait now
HDCHK: SKIPE BRK
MOVEM BRK,LASTOUT ;SAVE LAST CHAR PUT OUT
IFN ANDYSW,<SKIPN DISP,DESTIN+6 ;goddam STUPID tty?
JRST %HDCHK ;no, thank god
TLNN DISP,20 ;FULL CHAR. SET?
JRST NOTFUL ;NO
TLNE DISP,422000 ;CAN HE HAVE FULL CHAR. SET?
JRST %HDCHK ;YES
CAIL BRK,"a"
CAILE BRK,"z" ;LET LOWER CASE GO TO TTY
CAIA
JRST %HDCHK
TLNN DISP,110000 ;ARDS OR M37?
JRST NOTFUL ;NO
CAIE BRK,174 ;THESE CHARS CAN GO TO THEM
CAIN BRK,134 ;BACKSLASH
JRST %HDCHK
CAIE BRK,173
CAIN BRK,176
JRST %HDCHK
CAIN BRK,"`"
JRST %HDCHK
NOTFUL: CAIL BRK,173 ;upper range
MOVE BRK,TOPTBL-173(BRK);yes
CAIE BRK,"?" ;specials?
CAIN BRK,134
HRLI BRK,(BRK) ;yes
CAIG BRK,37 ;lower range?
MOVE BRK,QTBL-1(BRK) ;yes
CAIN BRK,140 ;another
MOVE BRK,[XWD <"@">,<"?">];yes
CAIL BRK,141 ;lower case?
CAIL BRK,173
CAIA ;no
JRST [ MOVSI BRK,-40(BRK)
HRRI BRK,"?"
JRST .+1]
TLNN BRK,-1 ;do we have 2 char?
JRST %HDCHK ;no, see how much time we wasted!
PUSHJ P,PUTCHR ;put out the bum
HLRZS BRK ;get the other guy
>;ANDYSW
%HDCHK: TLNN PRO,H ;NEED HEADERS?
JRST PUTCHF ;Put out char after doing special check for FormFeed
MOVEI DISP,0 ;CLEAR DISPATCH
TLZ BRK,-1 ;CLEAR FLAG.
CAIL BRK,11 ;is it in table
CAILE BRK,24
JRST [ CAIN BRK,40 ;no
MOVE DISP,[XWD NOHDR,%CHR]
CAIN BRK,177
MOVEI DISP,%CH177
JUMPN BRK,NODISP
TLNN TSWTCH,DEL177 ;IS THIS A PRINTING NULL?
JRST PUTCHR ;NO, JUST SEND IT
JRST NODISP]
MOVE DISP,DSPTCH-11(BRK) ;GET DISPATCH
NODISP: TLNN DISP,NOHDR ;ARE WE SUPPRESSING HEADER FOR THIS CHAR.
TLZN TSWTCH,HDR ;NO, DO WE NEED A HEADER?
CAIA
PUSHJ P,LPTHDR ;YA, YA, YA!
TLZE TSWTCH,DEL177 ;was last one a 177
TLC DISP,DELDSP ;yes change dipatch sense
TLNN DISP,DELDSP ;dispatch guys with bit off
JUMPN DISP,(DISP) ;and non-zero
%CHR: SOSL LCHCNT ;normal character, update count
JRST PUTCHR ;still on line
MOVEI LINLEN-1 ;WE'RE EATING ONE
MOVEM LCHCNT
SOSLE LINCNT ;that takes another line
JRST PUTCHR ;still on page
CAIN BRK,40 ;ignore space till later
%HDR: TLOA TSWTCH,HDR ;make header next time
%HDRNOW:PUSHJ P,LPTHDF ;do header now... this char. will print
JRST PUTCHR
%CH12: SOSLE LINCNT ;line feed, update line count
JRST PUTCHR ;still on page
MOVEI BRK,14 ;make last one on page a ff just for fun
JRST %HDR ;header next time
%CH11: SOS DISP,LCHCNT ;at least on space
ANDCMI DISP,7 ;now make it times 8
MOVEM DISP,LCHCNT ;stow it
JUMPGE DISP,PUTCHR ;jump if no new line
MOVEI DISP,LINLEN-10 ;THIS EATS 8
MOVEM DISP,LCHCNT
SOSG LINCNT ;new line?
TLO TSWTCH,HDR ;yes
JRST PUTCHR
%CH13: SOS DISP,LINCNT ;at least one line
PUSH P,DISP+1 ;stupid idivi
IDIVI DISP,=54/3 ;make it time 1/3 page
POP P,DISP+1
IMULI DISP,=54/3
MOVEM DISP,LINCNT ;save
IFN ANDYSW,<TLNE OUTCHR,TTYDEV
MOVEI BRK,13 >;ANDYSW
JUMPG DISP,PUTCHR ;jumpe if still on page
TLO TSWTCH,HDR ;make header next time
JRST PUTCHR
%CH14: TRNE PRO,NOF ;Suppressing FF's?
POPJ P, ;Yes, that's easy.
MOVEI 1 ;new physical page
MOVEM PHYPG
TLOE TSWTCH,HDR ;need header
POPJ P,
JRST PUTCHR
%CH15: MOVEI LINLEN ;nice fresh count
MOVEM LCHCNT
JRST PUTCHR
%CH21: SOS DISP,LINCNT ;one line feed
CAMG DISP,[-14] ;more than =12 LINES below bottom?
TLO TSWTCH,HDR ;yes need header.
IFN ANDYSW,<TLNE OUTCHR,TTYDEV
MOVEI BRK,12 >;ANDYSW
JRST PUTCHR
%CH177: TLO TSWTCH,DEL177
IFN ANDYSW,<TLNE OUTCHR,TTYDEV
MOVEI BRK,134 >;ANDYSW
JRST PUTCHR
;PCNTAB DSPTCH QTBL TOPTBL XWD <"
;OUTPUT CHAR TABLES
;fortran conversion table
PCNTAB: XWD 23,177 ;"*"
XWD 0,0 ;"+"
XWD 21,177 ;","
XWD 12,60 ;"-"
XWD 22,177 ;"."
XWD 24,177 ;"/"
XWD 12,12 ;"0"
XWD 0,14 ;"1"
XWD 20,177 ;"2"
XWD 0,13 ;"3"
;header dispatch table and bits
NOHDR←←400000 ;suppress header for this char.
DELDSP←←200000 ;bit means don't dispatch this char.
DSPTCH:
%CH11 ;11
%CH12 ;12
%CH13 ;13
XWD NOHDR,%CH14 ;14
XWD NOHDR,%CH15 ;15
0 ;16
0 ;17
XWD DELDSP,%CH13;20
XWD DELDSP,%CH21;21
XWD DELDSP,%CH13;22
XWD DELDSP,%CH13;23
XWD DELDSP,%CH13;24
IFN ANDYSW,<
;this table is all for the sucking tty.
;see me waste space
;waste.......waste........waste!!!!!!!!
QTBL: XWD <"!">,<"?">
XWD 42,<"?">
XWD <"#">,<"?">
XWD <"$">,<"?">
XWD <"%">,<"?">
XWD <"&">,<"?">
XWD <"'">,<"?">
XWD <"(">,<"?">
11
12
13
14
15
XWD <")">,<"?">
XWD <"*">,<"?">
XWD <"+">,<"?">
XWD <",">,<"?">
XWD <"-">,<"?">
XWD <".">,<"?">
XWD <"/">,<"?">
XWD <"0">,<"?">
XWD <"1">,<"?">
XWD <"2">,<"?">
XWD <"4">,<"?">
XWD <"6">,<"?">
XWD <"3">,<"?">
XWD <"=">,<"?">
XWD 74,<"?">
XWD 76,<"?">
XWD <"7">,<"?">
XWD <"8">,<"?">
TOPTBL: XWD <"[">,<"?">
XWD <":">,<"?">
XWD <"$">,134
XWD <"]">,<"?">
134
>;ANDYSW
;PUTCHF PUTCHR NXSPC2 NXSPC1 NXSPAC PUTCH1 SNDCHR OUTHIM NXGPER DOAGAIN
;PUTCHF, PUTCHR, SNDCHR, OUTHIM
PUTCHF: CAIN BRK,14
TRNN PRO,NOF ;Suppressing FFs?
JRST PUTCHR ;No, or else this isn't one.
POPJ P, ;Throw it away.
PUTCHR: TRNN PRO,XSPACE ;DELETING TRAILING SPACES?
JRST NXSPAC
CAIN BRK,40
JRST [ AOS NSPACE ;JUST COUNT SPACES
POPJ P,]
SKIPE NSPACE ;IF NO PRECEEDING SPACES
CAIN BRK,15 ;OR END OF LINE?
JRST NXSPC1 ;YES, JUST CLEAR COUNT (THIS FLUSHES SPACES)
PUSH P,BRK ;SAVE OUR CHAR
MOVEI BRK,40 ;GET A SPACE
NXSPC2: PUSHJ P,NXSPAC ;SEND A SPACE
SOSLE NSPACE ;COUNT DOWN
JRST NXSPC2 ;MORE TO GO
POP P,BRK ;GET BACK CHAR
NXSPC1: SETZM NSPACE ;CLEAR COUNT OF SPACES
NXSPAC: TLNN OUTCHR,LPTDEV!XGPDEV
JUMPE BRK,CPOPJ ;put out one char. to output device
MOVE ODEV ;checks if you are fudging pointers
TRNN 10 ;funny pointers?
JRST SNDCHR
SOSLE CNTR ;yes, use special pointers.
JRST PUTCH1
PUSHJ P,OUTHIM
MOVSI <POINT 7,0,34>⊗-22
HRR OFIL+1
MOVEM PNTR
MOVEI 5
IMUL OFIL+2
MOVEM CNTR
PUTCH1: IDPB BRK,PNTR
HRR PNTR
HRRM OFIL+1
POPJ P,
;this guy puts out the byte in wrd to the output device.
SNDCHR: SOSG OFIL+2
PUSHJ P,OUTHIM
IDPB BRK,OFIL+1
POPJ P,
;this is the output routine. it checks all the good bits.
;and does all the good things.
OUTHIM: IFN UDPSW,<TLNE OUTCHR,UDEV
JRST [ UOUT FO,
POPJ P,] >;UDPSW
OUT FO,0 ;TRY TO OUTPUT
POPJ P,
STATZ FO,1B25 ;end of tape bit.
JRST [ MTAPE FO,3 ;write eof.
MTAPE FO,3 ;another.
MTAPE FO,3 ;and another.
MTAPE FO,1 ;rewind.
TTYUUO 3,[ASCIZ/End of output tape. Mount next tape and RETURN./]
TTYUUO 11,
TTYUUO 4,
TTYUUO 11,
SETSTS FO,@ODEV ;set status.
POPJ P,] ;return.
STATZ FO,1B18 ;write lock switch.
JRST [ TLNN OUTCHR,DTADEV!MTADEV ;if not dectape or magtape
JRST .+1 ;we don't care.
TLNE OUTCHR,DTADEV ;dectape?
TTYUUO 3,[ASCIZ/Please write enable the DECtape, then RETURN to continue./]
TLNE OUTCHR,MTADEV ;magtape?
TTYUUO 3,[ASCIZ/Put the write ring in then RETURN to continue./]
TTYUUO 11,
TTYUUO 4,
TTYUUO 11,
SETSTS FO,@ODEV ;set status.
JRST OUTHIM] ;TRY AGAIN.
STATZ FO,7B20 ;error bits.
JRST [ TLNE PRO,IGNO ;IGNORE OUTPUT ERRORS?
JRST DOAGAIN ;YES
GETSTS FO,
TRNE 400000
OUTSTR[ASCIZ/IOIMPM, /]
TRNE 200000
OUTSTR[ASCIZ/IODERR, /]
TRNE 100000
OUTSTR[ASCIZ/IODTER, /]
IFN XGPSW,< TLNN OUTCHR,XGPDEV
JRST NXGPER
PUSH P,T ;THESE ARE USED BY FCERRP
PUSH P,T2
PUSH P,ALT
PUSHJ P,FCERRP ;CALL XGP ERROR GET AND PRINT ROUTINE
POP P,ALT
POP P,T2
POP P,T
NXGPER:
>;XGP
PUSHJ P,[ RECMES(<Output error for >,ODEV+1,OBUF,<Type Y to try again.>,-1)]
JRST QUIT
DOAGAIN:SETSTS FO,@ODEV ;CLEAR ERROR BITS!
SKIPLE OFIL+2 ;STILL POINTING TO FULL BUFFER?
POPJ P, ;NO, RETURN TO USER
JRST OUTHIM] ;YES, TRY OUTPUT AGAIN
STATZ FO,1B21
JRST [ TLNN OUTCHR,DTADEV
JRST [ERRMES(<Record out of bounds.>)]
PUSHJ P,[RECMES(Record out of bounds ,ODEV+1,OBUF,Type Y to write directory.,-1)]
HALT QUIT
JRST QUIT]
POPJ P, ;sucess, return.
;DPYPG DPYDEC DPYDC1
;DPYPG
IFN DISPSW,<
DPYPG: SETO
TTYUUO 6,0
CAME [-1] ;Check for detached
TLNN 460000 ;III OR DD or DM?
POPJ P, ;No
PUSH P,T
PUSH P,T2
PUSH P,T3
MOVE T3,[POINT 7,DPYWRD]
MOVEI T,1
MOVEM T,DPYWRD
MOVE T,LOGPG
PUSHJ P,DPYDEC
MOVE T,DDDPOS ;Assume DD
TLNE 400000
MOVE T,IIIPOS ;III
TLNE 40000
MOVE T,DMPOS ;Datamedia
MOVEM T,PAGBUF+1
MOVEI T2,LPAGBF ;Display program length for DD
SETZ T,
TLNE 20000 ;DATA DISC LINE?
SKIPA T,DDDCMD ;Yes, get extra command word for DD
MOVEI T2,LPAGBF-2 ;No CRLF or halt needed for III or DM
MOVEM T2,PAGE+1
MOVEM T,PAGBUF
POP P,T3
POP P,T2
POP P,T
SKIPN DDDDON ;Don't wait it last one still running
DPYOUT PAGE
POPJ P,
DPYDEC: IDIVI T,=10
JUMPE T,DPYDC1
HRLM T2,(P)
PUSHJ P,DPYDEC
HLRZ T2,(P)
DPYDC1: ADDI T2,60
IDPB T2,T3
POPJ P,
>;DISPSW
;LPTENT LPTNT1
;LPTENT
;this routine sets up the basic header
;except for page numbers.
LPTENT: MOVEI 1 ;logical page one
MOVEM LOGPG
MOVEM PHYPG ;and physical
TLNN PRO,H
POPJ P,
MOVE DISP,[POINT 7,LPTHD]
MOVEM DISP,LPTPTR
MOVE DISP,[IDPB BRK,LPTPTR] ;make routines go to LPTHD
EXCH DISP,ALTDEV
MOVEI BRK,15
XCT ALTDEV
CALLI T,14
PUSHJ P,DATOUT
SEVSTR[ASCIZ/ /]
CALLI T,22
IDIVI T,=3600
PUSHJ P,TIMOUT
SEVSTR[BYTE(7)11]
TLNN OUTCHR,TTYDEV
SEVSTR[ASCIZ/ /]
SETZM CHRCNT
SIXSTR SOURCE
HLLZ T,SOURCE+1
JUMPE T,LPTNT1
MOVEI BRK,"."
XCT ALTDEV
AOS CHRCNT
SIXSTR T
LPTNT1: MOVEI BRK,11
XCT ALTDEV
TLNE DEVCHR,DSKDEV!UDEV ;PPN ON DISK OR UDP ONLY
PPNSTR SOURCE+3
MOVEI BRK,11
MOVEI 10
TLNE OUTCHR,TTYDEV
CAMLE CHRCNT
XCT ALTDEV
SEVSTR[ASCIZ/ Page /]
MOVEM DISP,ALTDEV
POPJ P,
;LPTHDF LPTHDR LPTPRT LPTPR1 LPTPR2
;LPTHDF, LPTHDR
;this routine will put out a header.
;the LPTHDF entrance will put out a form feed first.
LPTHDF: PUSH P,BRK
MOVEI BRK,14
PUSHJ P,PUTCHR ;put out ff.
CAIA ;already saved brk.
LPTHDR: PUSH P,BRK ;save some ac's
PUSH P,T
PUSH P,T2
PUSH P,DISP
MOVE DISP,LPTPTR ;this is where LPTENT left off
MOVE ALT,[IDPB BRK,DISP]
MOVE T,LOGPG
PUSHJ P,R10OUT ;print logical page
MOVEI BRK,"-"
XCT ALT
MOVE T,PHYPG
PUSHJ P,R10OUT ;and physical page
MOVEI BRK,15
XCT ALT
MOVEI BRK,12 ;crlf
XCT ALT
XCT ALT
MOVEI BRK,0 ;terminate with null
XCT ALT
MOVE ALT,[POINT 7,LPTHD]
LPTPRT: ILDB BRK,ALT ;get a char from line
JUMPE BRK,LPTPR1 ;quit on null
PUSHJ P,PUTCHR ;bypass checks
JRST LPTPRT
LPTPR1: MOVE T,LCHCNT
SUBI T,LINLEN
MOVEI BRK," "
JRST LPTPR2 ;space back out to position in line
PUSHJ P,PUTCHR
LPTPR2: AOJLE T,.-1
MOVEI T,PGLEN-2
MOVEM T,LINCNT ;PGLEN-2 more lines to go
POP P,DISP
POP P,T2
POP P,T
POP P,BRK
AOS PHYPG ;new physical page
POPJ P,
;GETWRS GETWRD SKPSPC GETCHR GETCH1 SKPCHK GETCH2 GETCH3 GETQ GETWRB GETWRC
;SIXBIT SCANNER -- GETWRD
;This is the guy that gets the next word and puts it's sixbit
;representation in wrd, left justified.
;And puts the ascii representation of the break character
;following it in brk, right justified.
GETWRS: MOVE T5,[POINT 6,WRD]
SETZB T,WRD
TLZ TSWTCH,STRSWT ;NO STAR YET
JRST GETCHR ;DON'T SKIP LEADING SPACES
GETWRD: MOVE T5,[POINT 6,WRD] ;byte wrd in 6 bit bytes.
SETZB T,WRD ;zero wrd and t
TLZ TSWTCH,STRSWT ;NO STAR SEEN YET
SKPSPC: XCT CMDGET ;get chr.
CAIN BRK,40 ;space?
JRST SKPSPC ;yes, skip it.
CAIA ;you already have a char.
GETCHR: XCT CMDGET ;get next char.
CAIN BRK,1 ;quote char.
JRST GETQ
CAIN BRK,";" ;COMMENT CHARACTER?
JRST GETCH3 ;YES, SKIP TO END OF LINE
GETCH1: PUSHJ P,BRKCHK ;BRKCHK RETURNS UP ONE LEVEL IF BREAK CHAR
SKPCHK: SUBI BRK,40 ;no, make it sixbit.
TLNN T5,770000 ;END OF WORD?
JRST GETCH2
IDPB BRK,T5 ;put it in wrd.
LSH T,6
IOR T,BRK
GETCH2: SKIPE WRD
TLZ TSWTCH,NULFLG ;when we get something turn off nulflg.
JRST GETCHR ;get another.
GETCH3: XCT CMDGET ;HERE WE SKIP OVER COMMENTS IN COMMAND
CAIE BRK,12
CAIN BRK,ALTMOD
POPJ P, ;GOT END OF LINE
JRST GETCH3 ;SKIP MORE COMMENT
GETQ: XCT CMDGET ;HERE TO COLLECT QUOTED TERM
CAIN BRK,1
JRST GETCH2 ;BACK TO NORMAL LOOP
PUSHJ P,CHRFIX
SUBI BRK,40
JUMPL BRK,[ADDI BRK,40 ;MAKE IT PRINT CORRECTLY
CHRMES(Illegally quoted character.)]
TLNN T5,770000
JRST GETQ
IDPB BRK,T5
LSH T,6
IOR T,BRK
JRST GETQ ;LOOP UNTIL ANOTHER ↓
GETWRB: PUSHJ P,GETWRD
GETWRC: CAIE BRK," "
POPJ P,
PUSH P,WRD
PUSH P,T
PUSH P,TSWTCH ;SAVE FLAGS
PUSHJ P,GETWRD
JUMPN WRD,SYNERR ;SYNTAX ERROR IF ANYTHING FOLLOWS
POP P,TSWTCH ;RESTORE FLAGS
POP P,T
POP P,WRD
POPJ P,
;SOCTIN SDECIN SGET OCTIN DECIN SPCNUM GETNUM NUMPUT
;SOCTIN, SDECIN, OCTIN, DECIN
;OCTAL OR DECIMAL NUMBER SCANNER.
SOCTIN: SKIPA T5,[10]
SDECIN: MOVEI T5,=10
TLZ TSWTCH,STRSWT
SGET: XCT CMDGET
CAIN BRK," "
JRST SGET
CAIE BRK,"*"
JRST GETNUM ;must be number
PUSHJ P,STRCK1 ;RETURNS WITH PPOPJ1
OCTIN: SKIPA T5,[10] ;octal radix
DECIN: MOVEI T5,=10 ;decimal radix
SPCNUM: XCT CMDGET
GETNUM: CAIN BRK,"'" ;forcing octal?
JRST OCTIN ;yes
CAIN BRK,42 ;forcing decimal?
JRST DECIN ;yes
CAIN BRK," " ;skip spaces
JRST SPCNUM
SETZ WRD,
CAIL BRK,"0"
CAIGE T5,-<"0">+1(BRK)
JRST [ILLNUM:ERRMES(Illegal number!)];didn't even start number
NUMPUT: IMUL WRD,T5 ;multiply wrd by radix
ADDI WRD,-<"0">(BRK) ;add new fun guy
XCT CMDGET ;get another
CAIN BRK,";" ;COMMENT CHARACTER?
JRST GETCH3 ;YES, SKIP TO END OF LINE
PUSHJ P,CHRFIX ;convert lower case to upper case
CAILE BRK,"Z"
POPJ P,
CAIL BRK,"A"
JRST ILLNUM
CAIL BRK,"0"
CAILE BRK,"9"
POPJ P,
JRST NUMPUT
;BRKCHK STRCHK STRCK1 ILSTAR CHRFIX
;BRKCHK, STRCHK
;This routine decides what is a break character and what isn't.
;A break character is one that is not a letter, a number or a *.
BRKCHK: PUSHJ P,CHRFIX ;convert upper, make initial check
CAILE BRK,"Z"
JRST PPOPJ1 ;bigger than letter
CAIE BRK,"$" ;let dollar through for edit files!
CAIL BRK,"A"
POPJ P, ;letter
CAILE BRK,"9"
JRST PPOPJ1 ;bigger than number
CAIN BRK,"*"
JRST STRCHK ;star
CAIGE BRK,"0"
POP P,(P) ;less than number
POPJ P,
STRCHK: CAME T5,[POINT 6,WRD] ;BYTE POINTER USED YET?
JRST ILSTAR
STRCK1: PUSHJ P,GETWRS ;GET ANOTHER WORD, SEE LEADING SPACES
CAME T5,[POINT 6,WRD] ;STILL MUST NOT BE USED
JRST ILSTAR
MOVSI WRD,'* '
MOVEI T,'*'
TLZ TSWTCH,NULFLG
TLO TSWTCH,STRSWT
JRST PPOPJ1
ILSTAR: ERRMES("*" must be delimited.)
CHRFIX: SUBI BRK,40 ;sixbit
CAIL BRK,"A" ;is it lower case?
CAILE BRK,"Z"
CAIA ;no
POPJ P,
ADDI BRK,40 ;make it real again
POPJ P,
;CMDCHR CMDLF CMDCHB CMDCHC CMDCHA CMDIN CMDCH1 CMDCH2 TTYINP TTYIN
;CMDCHR, TTYIN, TTYINP, CMDIN
;this routine gets one char. from the indirect file into BRK.
;it invents line feeds at the end of a line if there isn't
;one there or at the beginning of the next except the last.
CMDCHR: PUSHJ P,CMDCHB ;GET ME A CHARACTER
POPJ P, ;BACK TO TTY, JUST RETURN
CAIE BRK,12 ;LINE FEED IS SPECIAL.
JRST [REMCHR: CAIE BRK,40 ;DON'T SEE BLANKS AS LAST
MOVEM BRK,C.LAST
POPJ P,]
MOVE BRK,C.LAST
CAIN BRK,"," ;WAS LAST CHAR A COMMA?
JRST CMDCHR ;YES, JUST IGNORE CHAR
CMDLF: PUSHJ P,CMDCHB ;GET CHAR.
POPJ P, ;BACK TO TTY, JUST RETURN
CAIN BRK,12 ;NO, WAS THIS ANOTHER LF
JRST CMDLF ;YES, KEEP LOOKING
CAIN BRK,"," ;NO, IS IT A COMMA
JRST REMCHR ;YES, JUST USE IT!
LDB BRK,[POINT 6,ICMD+1,11] ;GET BYTE SIZE (IN CASE IT'S A TTY)
LSH BRK,=30 ;PUT IN POSITION
ADDM BRK,ICMD+1 ;BACK UP BYTE POINTER
AOS ICMD+2 ;AND WORD COUNT
MOVEI BRK,"," ;INVENT LF
JRST REMCHR
CMDCHB: PUSHJ P,CMDCHA
POPJ P, ;EOF, RETURN IMMEDIATELY
CAIE BRK,";" ;SEMI-COLON IS COMMENT CHAR
JRST SPOPJ1
CMDCHC: PUSHJ P,CMDCHA
POPJ P,
CAIE BRK,12 ;EAT UNTIL LF
JRST CMDCHC
JRST SPOPJ1
CMDCHA: SOSLE ICMD+2 ;need input?
JRST CMDCH1
IFN UDPSW,<MOVE BRK,CMDDEV+1
CALLI BRK,4
TLNN BRK,UDEV
JRST CMDIN
UIN CMD,
JRST CMDCH1
JRST CMDEND
CMDIN: >;UDPSW
IN CMD, ;yes.
JRST CMDCH1
STATO CMD,1B22 ;EOF?
JRST [ERRMES(Error while reading command file.)]
IFN UDPSW,<CMDEND:>
RELEASE CMD, ;yes.
MOVE [TYI] ;go back to tty.
MOVEM CMDGET
MOVE BRK,SAVCHR ;get break char.
HRR TSWTCH,SAVSWT
MOVEM TSWTCH,DFTSWT
MOVE PRO,SAVPRO
MOVEM PRO,DFTPRO
MOVE SAVLIN
MOVEM DFTLIN
TLZ STK,-1 ;stack may now run over again
POPJ P, ;GIVE EOF RETURN
CMDCH1: ILDB BRK,ICMD+1 ;bet char.
JUMPE BRK,CMDCHA ;skip zeroes.
MOVE @ICMD+1 ;and line numbers.
TRNN 1
JRST CMDCH2
AOS ICMD+1
MOVNI 6
ADDM ICMD+2
ILDB BRK,ICMD+1
CMDCH2: CAIN BRK,14 ;ignore ff's.
JRST CMDCHA
CAIE BRK,15 ;and CR'S
CAIN BRK,32 ;and ↑Z from tty.
JRST CMDCHA
CAIN BRK,"+" ;convert +
MOVEI BRK,"," ;to ,
CAIN BRK,11
MOVEI BRK,40
JRST SPOPJ1
TTYINP: INCHRS BRK ;PASSWORD READER GETS CHARS THIS WAY
TTYIN: INCHWL BRK
ANDI BRK,177 ;NEVER WANT CONTROL BITS
CAIN BRK,15
JRST TTYIN
CAIN BRK,11
MOVEI BRK,40
IFN DECSW,<CAIE BRK,175
CAIN BRK,176
MOVEI BRK,ALTMOD
>;DECSW
POPJ P,
;RCVCHR INHIM INAGAIN EOFCHK
;RCVCHR, INHIM
;get one byte from input device in BRK
RCVCHR: SOSG IFIL+2
PUSHJ P,INHIM
ILDB BRK,IFIL+1
IFN SENDSW,<
TLNE TSWTCH,SNDSWT ;IS IT SEND ;REG
TLNN DEVCHR,TTYDEV ;SEND. TTY? ;REG
POPJ P, ;NOT (SEND∧TTY). RETURN
JUMPE BRK,RCVCHR ;FLUSH NULLS
SKIPN MESFLG ;ARE WE DOING THE MAGIC?
POPJ P, ;NO
EXCH BRK,C.LAST ;SAVE BRK
CAIE BRK,12 ;WAS LAST CH AN LF?
JRST [MOVE BRK,C.LAST ;NO GET CHAR BACK
POPJ P, ] ;RETURN
AOS IFIL+2 ;INCREMENT THE CHAR. COUNT
MOVE BRK,IFIL+1 ;GET THE BYTE POINTER
MOVSI BRK,70000
ADDM BRK,IFIL+1 ;BACKUP BYTE POINTER
MOVEI BRK,40 ;LOAD A BLANK
MOVEM BRK,C.LAST ;SAVE CHARACTER
>;SENDSW
POPJ P, ;RETURN
;this is the general input routine. It checks all the good bits.
;and does all the good things with them.
;It also checks whether or not the input really happened.
INHIM: IFN UDPSW,<TLNE DEVCHR,UDEV
JRST [ UIN FI,0
POPJ P,
JRST EOF] >;UDPSW
IN FI,0 ;INPUT
POPJ P,
STATZ FI,1B25 ;end of tape?
JRST [ MTAPE FI,1 ;rewind.
TTYUUO 3,[ASCIZ/End of input tape. Mount next tape and RETURN./]
TTYUUO 11,
TTYUUO 4,
TTYUUO 11,
SETSTS FI,@IDEV ;turn of bit.
POPJ P,] ;RETURN
STATZ FI,17B21 ;error bit?
JRST [ TLNE PRO,IGNI ;IGNORE INPUT ERRORS?
JRST INAGAIN ;YES
GETSTS FI,
TRNE 400000
OUTSTR[ASCIZ/IOIMPM, /]
TRNE 200000
OUTSTR[ASCIZ/IODERR, /]
TRNE 100000
OUTSTR[ASCIZ/IODTER, /]
TRNE 40000
OUTSTR[ASCIZ/IOBKTL, /]
PUSHJ P,[RECMES(<Input error for >,IDEV+1,SOURCE,<Type Y to ingore.>,-1)]
JRST EOFCHK ;GENERATE EOF ON ERROR
INAGAIN:SETSTS FI,@IDEV
SKIPG IFIL+2 ;STILL NEED INPUT?
JRST INHIM ;YES, TRY TO GET IT
POPJ P,]
STATZ FI,1B22 ;eof?
JRST [ TLC DEVCHR,SAVBIT!MTADEV
TLCN DEVCHR,SAVBIT!MTADEV
JRST PPOPJ1
MOVEI BRK,14
TLNE DEVCHR,TTYDEV ;IF TTY INPUT
MOVEM BRK,LASTOUT ;FAKE LAST CHAR AS FF
TLNE DEVCHR,DSKDEV
SKIPN GOPAGE
JRST EOF
PUSH P,DISP
ILDB DISP,STK
MOVEM DISP,GOPAGE
MOVEI DISP,1
MOVEM DISP,LOGPG
MOVEM DISP,PHYPG
POP P,DISP
SKIPN GOPAGE ;STILL SOMETHING TO DO?
JRST EOF ;NO
IFE STANSW,< USETI FI,1 ;GET TO FRONT>
IFN STANSW,< USETI FI,@USETP >
IN FI,0 ;CHECK FOR IMMEDIATE EOF
POPJ P,
JRST EOF]
SKIPLE IFIL+2
POPJ P,
JRST INHIM
EOFCHK: TLC DEVCHR,SAVBIT!MTADEV
TLCN DEVCHR,SAVBIT!MTADEV
JRST PPOPJ1
JRST EOF
;SPLMAK NOAL NAMTRY SPLLOS NAMOK SPOOK NOSPEX ALIPNT
;SPLMAK
IFN SPLSW,<
SPLMAK: MOVE WRD,(T2)
MOVEM WRD,FNAME
MOVE WRD,1(T2)
HLLZM WRD,FEXT
MOVE WRD,3(T2)
MOVEM WRD,FPPN
SETZM FDAT
LOOKUP SPLCHN,FNAME
JRST [ MOVE T,3(T2)
MOVEM T,FPPN
HRRZ T,FEXT
PUSHJ P,MESS22
PUSHJ P,[RECMES(Spool LOOKUP of ,SPLDEV+1,FNAME,Type Y to spool it anyway.,-1)]
POPJ P,
SETZ T,
JRST .+2]
MOVS T,FPPN ;GET LENGTH
MOVN T,T
ADDI T,177
LSH T,-7
MOVEM T,FSIZE
TRNN T3,SPDSWT ;/D?
TDZA T,T
MOVEI T,1 ;YES
MOVEM T,CBITS
MOVE WRD,3(T2)
MOVEM WRD,FPPN
TRNN T3,3 ;ALIAS NAME TO SET?
JRST [ SETZM ANAME
SETZM AEXT
SETZM APPN
JRST NOAL]
TRNE T3,4
SKIPA T,['*PGX*']
MOVE T,['*TPL*']
MOVEM T,ANAME
TRNE T3,1
SKIPA T,['OUT ']
MOVSI T,'LST'
MOVEM T,AEXT
SETZ T,
DEFPPN T,
MOVEM T,APPN
NOAL: CALLI T,24 ;GET CURRENT LOSER PPN FOR SURE
MOVEM T,RQNAM
CALLI T,14 ;DATE
HRLM T,RQTIME
CALLI T,23 ;TIME
IDIVI T,=60000 ;MAKE IT MINUTES
HRRM T,RQTIME
SETO T,
TTYUUO 6,T
HRLM T,RQJOB
CALLI T,30
HRRM T,RQJOB
TRNE T3,4 ;REALLY XGP?
SKIPA WRD,['XSP ']
MOVSI WRD,'SPX'
MOVEM WRD,SPLNAM+1
MOVE WRD,['SPLSYS']
NAMTRY: MOVEM WRD,SPLNAM+3
AOS SPLNAM
LOOKUP SPLCHN,SPLNAM
CAIA
JRST NAMTRY
HRRZ T,SPLNAM+1
JUMPE T,NAMOK
SPLLOS: MOVEM WRD,SPLNAM+3
PUSHJ P,MESS22
PUSHJ P,[RECMES(,SPLDEV+1,SPLNAM,<Type Y to try another name.>,-1)]
POPJ P,
JRST NAMTRY ;TRY ANOTHER
NAMOK: MOVEM WRD,SPLNAM+3 ;PUT PPN BACK
HLLZS SPLNAM+1
SETZM SPLNAM+2
ENTER SPLCHN,SPLNAM
JRST [ HRRZ T,SPLNAM+1
JRST SPLLOS]
OUT SPLCHN,SPWCMA ;PUT OUT LIST
JRST SPOOK
PUSHJ P,[RECMES(Output error ,SPLDEV+1,SPLNAM,<Type Y to try over.>,-1)]
CAIA
JRST NAMOK
SPOOK: CLOSE SPLCHN,
OUTSTR[ASCIZ/Spooled: /]
TRNE T3,3 ;ALIASING?
JRST ALIPNT
SIXOUT FNAME
HLLZ WRD,FEXT
JUMPE WRD,NOSPEX
OUTCHR["."]
SIXOUT WRD
NOSPEX: OUTCHR["["]
PPNOUT FPPN
OUTCHR["]"]
TRNE T3,SPDSWT ;SPOOL/D?
OUTSTR[ASCIZ+/D+] ;YES!
OUTSTR[ASCIZ/
/]
POPJ P,
ALIPNT: SIXOUT ANAME
OUTCHR["."]
SIXOUT AEXT
OUTCHR["["]
PPNOUT APPN
OUTSTR[ASCIZ+]/D
+]
POPJ P,
>;SPLSW
;PPOPJ1
;SPECIAL SINGLE LOCATIONS
PPOPJ1: POP P,(P)
IFN UDPSW,<↓>CPOPJ: POPJ P,
IFN UDPSW,<↓>SPOPJ2: AOS (P)
IFN UDPSW,<↓>SPOPJ1: AOS (P)
POPJ P,
XLIST
LIT
IFN TWO,<RELOC>
VAR
LIST
IFE UDPSW,<END START>